Delete rows out of date using a macro in an excel report
In most of the reports, when I am doing the monthly one, I just need to keep all data that are in the month report, and the others, I have to delete, so I just keep the current month, and delete the previous and next month.
When I use the macro ?
To delete cells where the date should not be in my report.
How to create the macro ?
Read How to create, edit, hide and select a macro in an excel report
How to create the button to associate it with the macro ?
Read How to create a button and associated it to a macro in an excel report
How is/are the macro(s) ?
Copy the code below and paste it into your macro. You will see my comments in green if exist so follow the help to adapt to your need.
For 1 single date column:
Sub test() Dim Rangr As Long Dim Cellr As Range Dim i As Long ' change A by your date column letter Rangr = Range("A" & Rows.Count).End(xlUp).Row ' change A by your date column letter Set Cellr = Range("A2:A" & Rangr) Application.ScreenUpdating = False For i = Rangr To 1 Step -1 If IsDate(Cellr.Cells(i)) Then ' checking current month, for previous < Int(DateSerial(Year(Date), Month(Date), 1 - 1)) and for next >= Int(DateSerial(Year(Date), Month(Date) + 1, 1)) If Cellr.Cells(i).Value >= Int(DateSerial(Year(Date), Month(Date), 1)) Then Cellr.Rows(i).EntireRow.Delete End If End If Next i Application.ScreenUpdating = True End Sub
For multiple date columns:
Sub test() Dim Rangr As Range Dim Cellr As Range Dim Arr() As Long Dim Num As Long Dim i As Long With ActiveSheet ' change A:B by your date column letters Set Rangr = Intersect(.Columns("A:B"),.UsedRange) End With Num = 0 For Each Cellr In Rangr If IsDate(Cellr.Value) Then ' checking current month, for previous < Int(DateSerial(Year(Date), Month(Date), 1 - 1)) and for next >= Int(DateSerial(Year(Date), Month(Date) + 1, 1)) If Cellr.Value >= Int(DateSerial(Year(Date), Month(Date), 1)) Then Num = Num + 1 ReDim Preserve Arr(1 To Num) Arr(Num) = Cellr.Row End If End If Next Cellr For i = Num To 1 Step -1 ActiveSheet.Rows(Arr(i)).Delete Next i End Sub
The issue with this one, sometimes it works well and sometimes not. If you take a good look in my example, you will see that it deleted 4 rows instead of 3 (row 12 deleted and should not). This is the workaround I use:
Sub test() Dim Rangr As Range Dim Cellr As Range With ActiveSheet ' change A:B by your date column letters Set Rangr = Intersect(.Columns("A:B"), .UsedRange) End With For Each Cellr In Rangr If IsDate(Cellr.Value) Then ' checking current month, for previous < Int(DateSerial(Year(Date), Month(Date), 1 - 1)) and for next >= Int(DateSerial(Year(Date), Month(Date) + 1, 1)) If Cellr.Value >= Int(DateSerial(Year(Date), Month(Date), 1)) Then ' change delete if you want another word Cellr.Value = "delete" End If End If Next Cellr Dim cde1 As Range Dim SrchRng ' change A:B by the same date column letters Set SrchRng = ActiveSheet.Range("A:B", ActiveSheet.Range("A:B").End(xlUp)) Do ' change delete by the same word Set cde1 = SrchRng.Find("delete", LookIn:=xlValues) If Not cde1 Is Nothing Then cde1.EntireRow.Delete Loop While Not cde1 Is Nothing End Sub
For each cell out of date, it will put “delete” then it will delete all rows with this word.
Interesting Topics
-
Be successfully certified ITIL 4 Managing Professional
Study, study and study, I couldn’t be successfully certified without studying it, if you are interested...
-
Be successfully certified ITIL 4 Strategic Leader
With my ITIL 4 Managing Professional certification (ITIL MP) in the pocket, it was time to go for the...
-
Hide visual and change background color based on selection
Some small tricks to customize the background colour of a text box...
-
Stacked and clustered column chart or double stacked column chart
In excel, I use a lot the combination of clustered and stacked chart...