Loop

R

Richard

Hi

I have the follwoing loop,

finalrow = Worksheets("Daily Summary").Range("A65536").End(xlUp).Row
Set RNGd = Worksheets("Daily Summary").Cells(finalrow, 1)
Do Until Worksheets("Daily Summary").Range(RNGd, RNGd).Value = TodaysDate
Worksheets("Daily Summary").Range(RNGd, RNGd.Offset(0, 39)).Copy
Destination:=Worksheets("Daily Summary").Range(RNGd, RNGd.Offset(0,
39)).Offset(1, 0)
finalrow = Worksheets("Daily Summary").Range("A65536").End(xlUp).Row
Set RNGd = Worksheets("Daily Summary").Cells(finalrow, 1)
Loop

Which basically checks the last cell in column A and if the date isn't equal
to today, it copies that row to the next empty row. The loop keeps going
until the final cell is equal to todays date.

1) Is there a better way of writing this code.

2) Specifically, I have to keep restating the final row and RNGd, can this
be avoided.

Thanks and Regards
Richard
 
J

Joel

Here arre two solutions that are very similar. The second copies the entire
row rather than the range A to AM. The destination of a copy only has to be
the first cell in most cases.

Sub test()

finalrow = Worksheets("Daily Summary").Range("A65536").End(xlUp).Row

Do Until Worksheets("Daily Summary").Range("A" & finalrow).Value = TodaysDate
Worksheets("Daily Summary").Range("A" & finalrow & ":AM" &
finalrow).Copy _
Destination:=Worksheets("Daily Summary").Range("A" & (finalrow + 1))
finalrow = finalrow + 1
Loop


End Sub
Sub test2()

finalrow = Worksheets("Daily Summary").Range("A65536").End(xlUp).Row

Do Until Worksheets("Daily Summary").Range("A" & finalrow).Value = TodaysDate
Worksheets("Daily Summary").Rows(finalrow).Copy _
Destination:=Worksheets("Daily Summary").Rows(finalrow + 1)
finalrow = finalrow + 1
Loop


End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top