Take out dates that are not current month

[Teddy]

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("Information").Range("AS2")
Set DstRng = Worksheets("Statistics").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

I have two worksheets “Information†and “Statisticsâ€. I would like to
search every row in Column AS of worksheet “Information†for dates. If any
date in Column AS is not a date within the current month I would like to cut
out the row from worksheet “Information†and insert it into worksheet
“Statisticsâ€.

This code above looks in every row of sheet “Information†/Column AS for a
date that is less than or equal to 30 days from today’s date. When a date in
Column AS matches that criterion then the entire row that the date is in is
transferred to a new row in worksheet “Statisticsâ€. I don’t want to do that,
I want the criterion to be based on the current month only. For example, if
I scanned Column AS in sheet “Information†and dates from November appeared,
I would like those rows to be cut from sheet “Information†and inserted into
sheet “Statistics†since the current month is December. Can you help me
modify the code?

 

[OssieMac]

Hi Teddy,

Use the Month function and compare that with month of date being tested.
Example
currentMonth = Month(Date)

Returns a number between 1 and 12.

Also note that Date returns today's date only. Now returns both Date and
Time. The above can be used with either Date or Now.

 

[Teddy]

Thank you for clarifying. It works now. Only problem is that rows in Column
AS without dates are being removed also. Do you know if there is any way to
skip over/ignore rows with no dates?

 

[Jacob Skaria]

To check whether the cell contains a date use IsDate...

For Each Cell In SrcRng
If IsDate(Cell) Then
'your other code

End If
Next

 

[Teddy]

Hi Jacob. Thanks for the input. I am getting an error message, perhaps my
mistake, it reads compile error: duplicate declaration in current scope.
Below is my code. I still had problems even after I tried changing the
variable names. What do you think?

Sub SearchDate()

For Each Cell In SrcRng
If IsDate(Cell) Then

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

currentMonth = Month(Date)

Set SrcRng = Worksheets("Information").Range("AS2")
Set DstRng = Worksheets("Statistics").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 If
Next

End Sub