Help needed with macro

[Eucalypta]

Dear All,
I kindly seek your assistance for the following:
Col B. Col. E Col.F Col.G Col.L Col.Q
Date Art# Pcs Price Order#
Formula(=IF(AND(B45<NOW()-60;L45="");"Alarm!!!";"").
To copy data that meets the criteria (today-60 days and col. L empty) I have
a macro:
Sub moveitems()

With Sheets("Sheet1")
OldRowCount = 5
NewRowCount = 3
Do While .Range("B" & OldRowCount) <> ""
If IsDate(.Range("B" & OldRowCount)) Then
If (Date - .Range("B" & OldRowCount)) > 60 And _
.Range("L" & OldRowCount) = "" Then

.Range("E" & OldRowCount & ":H" & OldRowCount).Copy _
Destination:=Sheets("Sheet2").Range("A" & NewRowCount)
NewRowCount = NewRowCount + 1

End If
End If
OldRowCount = OldRowCount + 1
Loop
End With
End Sub

My problem is that after a few rows, the macro stops. It does not seem to
check all 1024 rows. Why?
Awaiting your kind reply,
Kind regards,
Eucalypta

 

[Don Guillett]

try this idea

With Sheets("Sheet1")
lr=.cells(rows.count,"b").end(xlup).row
for i=2 to lr
if isdate(.cells(i,"b")) and date-.cells(i,"b")>60 then _
.range(.cells(i,"e"),.cells(i,"h")).copy _
Sheets("Sheet2").cells(i,"A")
End With
End Sub

 

[FSt1]

hi
i would be suspicious of this if clause......
If (Date - .Range("B" & OldRowCount)) > 60 And _
.Range("L" & OldRowCount) = "" Then

.Range("E" & OldRowCount & ":H" & OldRowCount).Copy _
Destination:=Sheets("Sheet2").Range("A" & NewRowCount)
NewRowCount = NewRowCount + 1
End If
because if date=range not > 60 then it skips over it including the counter.
try moving the counter outside the if clause but still with in the loop.

regards
FSt1

 

[Eucalypta]

Hi,
thx for yr response. how do i move the counter outside the if clausule? i
have not much experience with macros.
awaiting yr kind response,
kg, eucalypta

 

[Eucalypta]

Hi Don,
unfortunately something seems to be missing in yr macro below. I.e. when I
run the macro, excel (2003) tells me it misses a Next command.
Awaiting yr kind response,
kg, Eucalypta

 

[Don Guillett]

Oooooops. Next to last line should be
next

 

[Eucalypta]

Hi Don, no problem, made the change. Macro looks as follows:
Sub copyitems()
With Sheets("Sheet 1")
lr = .Cells(Rows.Count, "b").End(xlUp).Row
For i = 5 To lr
If IsDate(.Cells(i, "b")) And Date - .Cells(i, "b") > 60 Then _
.Range(.Cells(i, "e"), .Cells(i, "h")).Copy _
Sheets("Sheet2").Cells(i, "A")
End With
Next
End Sub

Excel tells me: "Compile error: End With without With." Did i make a typo?
KG, Eucalypta

 

[Don Guillett]

My error. I MEANT to next to last line in the macro body. I did NOT test.
If it still doesn't work send me your file.

With Sheets("Sheet1")
lr=.cells(rows.count,"b").end(xlup).row
for i=2 to lr
if isdate(.cells(i,"b")) and date-.cells(i,"b")>60 then _
.range(.cells(i,"e"),.cells(i,"h")).copy _
Sheets("Sheet2").cells(i,"A")
NEXT i
End With
End Sub

 

[Eucalypta]

Hi Don,
sent the file separetly for your audit.
KG, Eucalypta

 

[Eucalypta]

Hi,
as I am not at all experienced with macros, kindly rewrite the macro for me
if you please.
awaiting your kind reply.
KG, Eucalypta