Hi I am having a problem with this code, it gets stuck in a loop even
when I set it up to work

The Start and Finish ranges are dates

Sheets("Sheet1").Select
Range("E2").Select
Do Until ActiveCell = ""

If ActiveCell.Value = Range("Start") Then
If ActiveCell.Value <= Range("Finish") Then
ActiveCell.Rows("1:1").EntireRow.Copy
Destination:=Sheets("Sheet2").Range("A4000").End(x lUp).Offset(3, 0)

ActiveCell.Offset(1, 0).Range("A1").Select

End If
End If

Loop

ActiveCell.Columns("A:F").EntireColumn.EntireColum n.AutoFit


I have all the date ranges formated as "mmm. dd, yyyy"


Thanks for the help.

Hi

You need to take the line
ActiveCell.Offset(1, 0).Range("A1").Select

to the line after 2 End If statements.

If Cell E2 is before Start, then ActiveCell never gets stepped up.

--
Regards

Roger Govier


"D." wrote in message
ups.com...
Hi I am having a problem with this code, it gets stuck in a loop even
when I set it up to work

The Start and Finish ranges are dates

Sheets("Sheet1").Select
Range("E2").Select
Do Until ActiveCell = ""

If ActiveCell.Value = Range("Start") Then
If ActiveCell.Value <= Range("Finish") Then
ActiveCell.Rows("1:1").EntireRow.Copy
Destination:=Sheets("Sheet2").Range("A4000").End(x lUp).Offset(3, 0)

ActiveCell.Offset(1, 0).Range("A1").Select

End If
End If

Loop

ActiveCell.Columns("A:F").EntireColumn.EntireColum n.AutoFit


I have all the date ranges formated as "mmm. dd, yyyy"


Thanks for the help.

Thanks alot, it loops fine now, but it is copying and pasting
everything into sheet2


Here is the code I have come up with



Sheets("Sheet1").Select
Range("E2").Select
Do While ActiveCell.Value < ""

If ActiveCell.Value = Range("Start") <= Range("Finish") Then
ActiveCell.Rows("1:1").EntireRow.Copy
Destination:=Sheets("Sheet2").Range("A4000").End(x lUp).Offset(1, 0)


End If
Sheets("Sheet1").Select

ActiveCell.Offset(1, 0).Range("A1").Select

Loop

What should I change for the conditions to be met??

Hi

The following seemed to work fine for me

Sub test()
Sheets("Sheet1").Select
Range("E2").Select
Do Until ActiveCell = ""
If ActiveCell.Value = Range("Start") Then
If ActiveCell.Value <= Range("Finish") Then
ActiveCell.EntireRow.Copy _
Destination:=Sheets("Sheet2").Range("A4000").End(x lUp).Offset(3, 0)

End If
End If
ActiveCell.Offset(1, 0).Range("A1").Select
Loop
End Sub


--
Regards

Roger Govier


"D." wrote in message
ups.com...
Hi I am having a problem with this code, it gets stuck in a loop even
when I set it up to work

The Start and Finish ranges are dates

Sheets("Sheet1").Select
Range("E2").Select
Do Until ActiveCell = ""

If ActiveCell.Value = Range("Start") Then
If ActiveCell.Value <= Range("Finish") Then
ActiveCell.Rows("1:1").EntireRow.Copy
Destination:=Sheets("Sheet2").Range("A4000").End(x lUp).Offset(3, 0)

ActiveCell.Offset(1, 0).Range("A1").Select

End If
End If

Loop

ActiveCell.Columns("A:F").EntireColumn.EntireColum n.AutoFit


I have all the date ranges formated as "mmm. dd, yyyy"


Thanks for the help.