Help copying rows and arranging in new sheet

[flurry]

I'm completely new to VBA in Excel but need to create a functionality to
copy rows from one sheet to another - but only if there is a 'n' in
Column A of the row. Then when it's copied into the new sheet I need to
be able to sort it by Column B (a date) and if the date is older than
today's it ideally needs to be deleted or hilighted in some way - but
this part is not essential. This seems like a tall order to me, but
then hopefully someone out there can help me! P.S. This can be put into
a macro button rather than just 'happen automatically'. Hope this makes
sense.

 

[Guest]

Sub copyData
Dim rng as Range, cell as Range
Dim sh as Worksheet, sh1 as Worksheet
set sh = Activesheet
set sh1 = Worksheets("Sheet2")
set rng = sh.Range(sh.Cells(1,1),sh.Cells(rows.count,1).end(xlup))
for each cell in rng
if lcase(cell.value) = "n" and _
cell.offset(0,1).Value >= date then
cell.EntireRow.copy sh.Cells(rows.count,1).End(xlup)(2)
End if
Next
End Sub


If you need to sort it, turn on the macro recorder while you do it manually,
then turn off the recorder and look at the recorded code.

 

[flurry]

Thanks so much for this! It's near perfect - only thing it seems to be
doing is copying the data to the bottom of sheet one instead of onto
sheet 2. any help ammending this would be much appreciated! Thanks V.
much!

 

[dnclark]

I want to do something similar with a macro and think it would just
take a few changes to this macro.

I want the macro to check for a value in a column and if that value
exists copy a range of cells from that row to the next sheet.

A B C D E
1 1 x x x x
2 y y y y
3 1 z z z z
4 x x x x
5 1 y y y y

For example, if there is a 1 in column A, copy cells C1 through E1 from
that row to the new sheet starting the paste at row 11 (leaving space
for a header).

Tom Ogilvy's code does essentially what I want but it copies a row not
just certain range of cells.

Sub copyData
Dim rng as Range, cell as Range
Dim sh as Worksheet, sh1 as Worksheet
set sh = Activesheet
set sh1 = Worksheets("Sheet2")
set rng = sh.Range(sh.Cells(1,1),sh.Cells(rows.count,1).end( xlup))
for each cell in rng
if lcase(cell.value) = "n" and _
cell.offset(0,1).Value >= date then
cell.EntireRow.copy sh.Cells(rows.count,1).End(xlup)(2)
End if
Next
End Sub

The following two macros each do a different part of what I want to do.
The first has the value checking I want but copies the whole row. The
second macro checks for differences in values (don't want) and then
copies a range of cells (want). Unfortunately I'm not far enough along
in VBA to understand how to mash the two together! These two macros
come from Tech on the Net at http://www.techonthenet.com/excel/macros/.


Macro 1:

Sub SearchForString()

Dim LSearchRow As Integer
Dim LCopyToRow As Integer

On Error GoTo Err_Execute

'Start search in row 4
LSearchRow = 4

'Start copying data to row 2 in Sheet2 (row counter variable)
LCopyToRow = 2

While Len(Range("A" & CStr(LSearchRow)).Value) > 0

'If value in column E = "Mail Box", copy entire row to
Sheet2
If Range("E" & CStr(LSearchRow)).Value = "Mail Box" Then

'Select row in Sheet1 to copy
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
Selection.Copy

'Paste row into Sheet2 in next row
Sheets("Sheet2").Select
Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
ActiveSheet.Paste

'Move counter to next row
LCopyToRow = LCopyToRow + 1

'Go back to Sheet1 to continue searching
Sheets("Sheet1").Select

End If

LSearchRow = LSearchRow + 1

Wend

'Position on cell A3
Application.CutCopyMode = False
Range("A3").Select

MsgBox "All matching data has been copied."

Exit Sub

Err_Execute:
MsgBox "An error occurred."

End Sub


Macro 2:



Sub CopyData()

Dim LMainSheet As String
Dim LRow As Integer
Dim LContinue As Boolean

Dim LColAMaster As String
Dim LColATest As String

'Retrieve name of sheet that contains the data
LMainSheet = ActiveSheet.Name

'Initialize variables
LContinue = True
LRow = 2

'Start comparing with cell A2
LColAMaster = "A2"

'Loop through all column A values until a blank cell is found
While LContinue = True

LRow = LRow + 1
LColATest = "A" & CStr(LRow)

'Found a blank cell, do not continue
If Len(Range(LColATest).Value) = 0 Then
LContinue = False
End If

'Found occurrence that did not match, copy data to new
sheet
If Range(LColAMaster).Value <> Range(LColATest).Value Then

'Copy headings
Range("A11").Select
Selection.Copy

'Add new sheet and paste headings into new sheet
Sheets.Add.Name = Range(LColAMaster).Value
ActiveSheet.Paste
Range("A1").Select

'Copy data from columns A - D
Sheets(LMainSheet).Select
Range(LColAMaster & "" & CStr(LRow - 1)).Select
Selection.Copy

'Paste results
Sheets(Range(LColAMaster).Value).Select
Range("A2").Select
ActiveSheet.Paste
Range("A1").Select

'Go back to Main sheet and continue where left off
Sheets(LMainSheet).Select
LColAMaster = "A" & CStr(LRow)

End If

Wend

Range("A1").Select
Application.CutCopyMode = False

MsgBox "Copy has completed."

End Sub

 

[dnclark]

Flurry,

I think that "Macro 1" that I posted above would work well for the
copying you want to do. I have used it before. You would need to
change the column searched and the search value. See line 18--the
default is Column E and "Mail Box".

Regards,

Don

 

[flurry]

Thanks for that - yep, I think you're right - I've just tried the Macro
1 and it does the job more or less. Only thing I need to do now is try
to work out how to get it to remove the rows when the date column has
gone beyond today's date! Wish me luck! Ta.