Between Dates Criteria

[AirgasRob]

I want to be able to do something while inbetween dates. Start date is in D1
and End date is in D2. Across row 1 starting in G1 is dates (01/01/09,
02/01/09, etc...)

Sub Test1()

Range("G3:G5").Select
Selection.Copy

Range("G1").Select
Do While ((ActiveCell) >= Range("D1"))
ActiveCell.Offset(0, 1).Select
If ((ActiveCell) <= Range("D2")) Then
Exit Do
End If
Loop
ActiveCell.Offset(2, 0).Select
ActiveSheet.Paste
End Sub

 

[Joel]

See if this code is bettedr. Itried to figurre out what you where attempting
to execute in a better format.

Sub Test1()

RowCount = 1
Do While Range("D" & RowCount) <> ""
FirstDate = Range("D" & RowCount)
SecondDate = Range("E" & RowCount)
If FirstDate >= Range("D1") And _
SecondDate <= Range("D2") Then

Exit Do
End If

RowCount = RowCount + 1
Loop

Range("G3:G5").Copy _
Destination:=Range("D" & (RowCount + 2))

End Sub

 

[AirgasRob]

Joel thanks for your help. Your code looks like it goes down a column and I
need my code to go across columns.

01/01/08 02/01/08 03/01/08 04/01/08 05/01/08 06/01/08 07/01/08

If D1 equals 02/01/08 and D2 equals 05/01/08 then paste contents of G3:G5 to
the cells below each date.

01/01/08 02/01/08 03/01/08 04/01/08 05/01/08 06/01/08 07/01/08
Test1 Test1 Test1 Test1
Test2 Test2 Test2 Test2
Test3 Test3 Test3 Test3

 

[AirgasRob]

This code does what I want it to but it looks very messy to me. Is their a
more efficient way of doing this?

Sub Test3()
Range("G3:G5").Select
Selection.Copy
Range("G1").Select
Do While ((ActiveCell) <> Range("D1"))
ActiveCell.Offset(0, 1).Select
If ((ActiveCell) >= Range("D2")) Then
Exit Do
End If
Loop
ActiveCell.Offset(2, 0).Select
ActiveSheet.Paste
ActiveCell.Offset(-2, 0).Select
Do While ((ActiveCell) >= Range("D1"))
ActiveCell.Offset(0, 1).Select
ActiveCell.Offset(2, 0).Select
ActiveSheet.Paste
ActiveCell.Offset(-2, 0).Select

If ((ActiveCell) >= Range("D2")) Then
Exit Do
End If
Loop

 

[Joel]

Try this


Sub Test3()

ColCount = Range("G1").Columns
Do While Cells(1, ColCount) <= Range("D2")
If Cells(1, ColCount) >= Range("D1") Then
Range("G3:G5").Copy
Cells(2, ColCount).PasteSpecial _
Paste:=xlPasteAll, _
Transpose:=True
End If
ColCount = ColCount + 1
Loop
End Sub