fixing a loop
I hope the dates are in excel date format....Try the below and feedback
Sub test5()
Dim Reviews As Range, Cell As Object
Set Reviews = Range("G3:G900")
'Rather then looping until 900th row; the below will identify the last
filled row and
'set range accordingly
'Set Reviews = Range("G3:G" & Cells(Rows.Count, "G").End(xlUp).Row)
lngRow = 2
For Each Cell In Reviews
If Cell.Value = DateValue("30/Sep/2009") Then
Sheets("September").Range("A" & lngRow & ":G" & lngRow) = _
Range("A" & Cell.Row & ":G" & Cell.Row).Value
lngRow = lngRow + 1
End If
Next
End Sub
If this post helps click Yes
---------------
Jacob Skaria
"Bradly" wrote:
I have a sheet with information for 900 clients entitled "550+ List". Each
client has a different month for a case review. For example, clients who
have September reviews have the date "9/30/2009" in the "Next Review" column.
I have come up with a short macro that searches the list for all clients
with, for example, September reviews. When it finds a client with a
September review date, it copies the entire row, and pastes the information
(in columns A:G) on a different sheet entitled "September". It goes through
the entire list fine, with one problem: on the September sheet, the macro
starts pasting information on row 2, which is pasting over the column
headings.
Here is the code I have:
Sub test5()
'
' test5 Macro
'
'
Dim Reviews As Range, Cell As Object
Set Reviews = Range("G3:G900")
For Each Cell In Reviews
If Cell.Value = "9/30/2009" Then
Cell.EntireRow.Copy
Sheets("September").Activate
ActiveCell.Offset(rowOffset:=1, columnOffset:=0).Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
End If
Next
End Sub
I have two questions.
1) How can I get the code to begin pasting on row 3 of the "September" sheet
instead of row 2?
2) Is it possible to change my code so that only columns A:G are copied
instead of the entire row (the copied selection goes way off to the right of
the screen--all I really need are columns A:G)?
Thanks.
|