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 the macro ?
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.
When you are managing a team, “how to be a good manager” is the “must”...
As manager, I am doing many reports, even when I was an ITIL consultant, I still needed to do many reports...
ITIL V3 is going to be obsolete...
Managing an IT service when I start a new company is not an easy task, particularly true, if the service...