Sub SearchDate()

Dim Cell As Range
Dim CheckDate As Date
Dim DstRng As Range
Dim NextRow As Long
Dim Rng As Range
Dim RngEnd As Range
Dim SrcRng As Range

CheckDate = Int(Now()) - 30

Set SrcRng = Worksheets("Sheet1").Range("B2")
Set DstRng = Worksheets("Sheet2").Range("A2")

Set RngEnd = SrcRng.Parent.Cells(Rows.Count, SrcRng.Column).End(xlUp)
Set SrcRng = IIf(RngEnd.Row < SrcRng.Row, SrcRng,
SrcRng.Parent.Range(SrcRng, RngEnd))

Set RngEnd = DstRng.Parent.Cells(Rows.Count, DstRng.Column).End(xlUp)
Set DstRng = IIf(RngEnd.Row < DstRng.Row, DstRng, RngEnd.Offset(1, 0))

For Each Cell In SrcRng
If Cell = CheckDate And Cell <= Int(Now()) Then
If Rng Is Nothing Then Set Rng = Cell
Set Rng = Union(Rng, Cell)
Cell.EntireRow.Copy DstRng.Offset(NextRow, 0)
NextRow = NextRow + 1
End If
Next Cell


If Not Rng Is Nothing Then Rng.EntireRow.Delete

End Sub


This code looks in every row of Sheet 1/Column B for a date that is less
than or equal to 30 days from todays date. When a date in Column B matches
that criterion the entire row that the date is in is transferred to a new row
in Sheet2.

I would like to change the search criterion and I am looking for help. I
would like the macro to look for a date that is 30 days before todays date
first (today it would be 6/17/09). Once that date is identified then I would
like the macro to look in every row of Sheet1/Column B for every date that is
less than or equal 30 days before that date; when those dates are found I
would like to transfer them and their rows only to Sheet2 into a new row. If
you can help, thank you.