Macro to delete entire row if date in column G is older than the current month a year ago

[AnthoHead]

I need to figure out how to change the below macro to delete all dates from 1 year ago prior to the month we are currently in. For example, because today is March 17th, the below will delete all rows prior to March 17th 2022, but I want all of March. I want it to delete everything prior to March vs. prior to March 17th.

Any suggestions?

Sub DeleteDateOlderThan365()
Dim lR As Long, R As Range, i As Long
lR = Range("G" & Rows.Count).End(xlUp).Row
Set R = Range("G1:G" & lR)
Application.ScreenUpdating = False
For i = lR To 1 Step -1
If IsDate(R.Cells(i)) Then
If Date - R.Cells(i).Value > 365 Then
R.Rows(i).EntireRow.Delete
End If
End If
Next i
Application.ScreenUpdating = True
End Sub

 

[James006]

Hi,
You could test Date-Day(Date) :

Sub DeleteDateOlderThan365()
Dim lR As Long, R As Range, i As Long
lR = Range("G" & Rows.Count).End(xlUp).Row
Set R = Range("G1:G" & lR)
Application.ScreenUpdating = False
    For i = lR To 1 Step -1
        If IsDate(R.Cells(i)) Then
            If Date - Day(Date) - R.Cells(i).Value > 365 Then
                R.Rows(i).EntireRow.Delete
            End If
        End If
    Next i
Application.ScreenUpdating = True
End Sub

 

[MARK858]

Just another option

Sub DeleteDateOlderYearAgo()
    Dim i As Long, lR As Long
     Application.ScreenUpdating = False
     
    lR = Range("G" & Rows.Count).End(xlUp).Row

    For i = lR To 1 Step -1
        If IsDate(Cells(i, "G")) Then
            If Cells(i, "G") < DateSerial(Year(Date) - 1, Month(Date), 1) Then
                Rows(i).Delete
            End If
        End If
    Next i
   
End Sub