Whoa, this is awesome. Thank you Matt. I am grateful for the help.

Regards,

Jazz

"Matthew Herbert" wrote:

On Jul 19, 12:28 pm, Jazz wrote:
Hi Matt,

From the feedback I got I realized that I wasnt entirely clear. My
apologies. What I am trying to do, whenever I run the macro, is get the date
which is 30 days from todays date. Once I have found that date. I want to
grab all the dates that are less than or equal to 30 days from the new date.

For example, lets say I ran the macro today. This is what I want to have
happen

1. Today is 7/19/09
2. 30 days before 7/19/09 is 6/19/09
3. Here are all the rows in Sheet1 with dates in Column B that are less than
or equal to 30 days before 6/19/09; next the list gets
pasted into Sheet2.

Please let me know if there is still any ambiguity. Yes you are correct, if
I want every row in Column B I should say SrcRng = Columns("B"). Thank again
for your help.

Regards,

Jazz

P.S. Your modifications to the macro are really good.



"Matthew Herbert" wrote:
On Jul 17, 3:11 pm, Jazz wrote:
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.

Jazz,

It appears that you are already making that comparison (unless I've
drastically missed something). The code below lists the following:
Cell = CheckDate And Cell <= TodayDate; or in other words, Cell =
6/17/09 And Cell <= 7/17/09. As you stated, this is "30 days before
today's date".

I added another variable (TodayDate) and moved some of the code from
the For Each loop to the If Then statement below the For Each loop.
(An alternative method would be to use the Find method to create a
unioned range of dates found. See the VBE help files for "Find
Method" for more details). Also, if you want "every" row in Column B,
then change your SrcRng to Set SrcRng = Columns("B").

Best,

Matthew Herbert

Sub SearchDate()

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

TodayDate = Int(Now())
CheckDate = TodayDate - 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 <= TodayDate Then
If Rng Is Nothing Then Set Rng = Cell
Set Rng = Union(Rng, Cell)
End If
Next Cell

If Not Rng Is Nothing Then
Rng.EntireRow.Copy DstRng
Rng.EntireRow.Delete
End If

End Sub- Hide quoted text -

- Show quoted text -

Jazz,

Add another date variable (which I've called NewDate = CheckDate - 30)
and then run your If Then statement (If Cell = NewDate And Cell <=
CheckDate Then). I included all the code below which you can adjust
as you please.

Best,

Matthew Herbert

Sub SearchDate()

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

TodayDate = Int(Now())
CheckDate = TodayDate - 30
NewDate = CheckDate - 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 = NewDate And Cell <= CheckDate Then
If Rng Is Nothing Then Set Rng = Cell
Set Rng = Union(Rng, Cell)
End If
Next Cell

If Not Rng Is Nothing Then
Rng.EntireRow.Copy DstRng
Rng.EntireRow.Delete
End If

End Sub