Delete rows if month of the date is older than last month of the date registered

[Hansulet]

I have a sheet with many columns and the date is registered in column C.

I need a macro to delete those rows in which the month in the date recorded in column C is older than the last month recorded in column C.

Thank you in advance

 

[Joe4]

I am afraid that your question is not quite clear to me (and possibly others). If you are comparing dates in column C to the oldest month in column C, it can never be before it!

Perhaps it will be clearer if you post an exmple of your data for us to see, and tell us the expected results of that example.

MrExcel has a tool called “XL2BB” that lets you post samples of your data that will allow us to copy/paste it to our Excel spreadsheets, so we can work with the same copy of data that you are. Instructions on using this tool can be found here: XL2BB Add-in

Note that there is also a "Test Here” forum on this board. This is a place where you can test using this tool (or any other posting techniques that you want to test) before trying to use those tools in your actual posts.

 

[Hansulet]

In column C, we entered calendar data. Suppose that the last calendar date entered is 28.08.2021. I need a macro to delete the rows in which the calendar date month is less than month 8.

 

[Peter_SSs]

Suppose that the last calendar date entered is 28.08.2021. I need a macro to delete the rows in which the calendar date month is less than month 8.

Give this a try with a copy of your workbook.

Sub Del_Older_Months()
  Dim a As Variant, b As Variant
  Dim nc As Long, i As Long, k As Long, LastMnth As Long
 
  nc = Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
  With Range("C2", Range("C" & Rows.Count).End(xlUp))
    a = .Value
    LastMnth = Evaluate("month(max(" & .Address & "))")
  End With
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    If Month(a(i, 1)) < LastMnth Then
      b(i, 1) = 1
      k = k + 1
    End If
  Next i
  If k > 0 Then
    Application.ScreenUpdating = False
    With Range("A2").Resize(UBound(a), nc)
      .Columns(nc).Value = b
      .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo
      .Resize(k).EntireRow.Delete
    End With
    Application.ScreenUpdating = True
  End If
End Sub

 

[Hansulet]

Thanks a lot!
It is PERFECT!!!!!

 

[Peter_SSs]

You're welcome. Thanks for the confirmation.