SearchDate

[Jazz]

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 today’s 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 today’s 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.

 

[Matthew Herbert]

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 today’s date.  When a date in Column B matches
that criterion the entire row that the date is in is transferred to a newrow
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 today’s date
first (today it would be 6/17/09).  Once that date is identified then Iwould
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

 

[ker_01]

Jazz- While I think I understand what you are asking, I'm not sure you've
provided enough information about your requirements - please see the
following example(s)

Today's date = n
First date parameter = n-30

Sample dates:

n-15
n-25
n-29
n-50

In your given scenario, it would find the first value (n-15) then look for
anything that is within 30 days prior (e.g. between n-45 and n-15).
Therefore, it would move rows 2 and 3 to your second sheet. When it reaches
row 4, it would skip that record because n-50 is less than n-45. As the
program iterates through rows, it would also skip n-50 on an outer loop,
because it is outside of your original n-30 criteria.

However, if the dates are not in ascending order, maybe you start with:
n-25
n-15
n-50
n-29

in which case, when you hit n-25 you would generate criteria looking for
anything between n-55 to n-25, and you would grab both the n-50 and n-29 (in
the previous example, you didn't grab n-50). Having your results be dependent
on the order of items in your worksheet may produce less predictable results.

If the dates were in reverse order:
n-50
n-29
n-25
n-15
Then if your inner loop starts at the current outer loop position, it would
never return anything at all, because there would never be any older dates
below the current record. If the inner loop needs to loop all values
(including the ones already processed by the outer loop) I see even more
opportunity for confusing results...

Anyway, it might be worth providing a little more detail about what the date
ranges represent to your analysis, and what you are trying to accomplish with
pulling over certain items based on their date relationship to other items,
so we can do a better job of making suggestions that will meet your needs.

 

[Jazz]

Hi Matt,

From the feedback I got I realized that I wasn’t entirely clear. My
apologies. What I am trying to do, whenever I run the macro, is get the date
which is 30 day’s from today’s 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.

 

[Jazz]

Hi Ker,

Thank you for your feedback. You made some really good points. I think I
need to think through what I am saying a little bit more to make sure it is
more thorough. However, in the meantime, perhaps this explanation may
provide a little more clarity

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.

Thanks again,

Regards,

Jazz

 

[Matthew Herbert]

Hi Matt,

From the feedback I got I realized that I wasn’t entirely clear.  My
apologies.  What I am trying to do, whenever I run the macro, is get the date
which is 30 day’s from today’s 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 thatare 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.















- 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

 

[Jazz]

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

Regards,

Jazz