Sub DeleteRows()
    Dim i As Long, LastRow As Long, t As Double, r As Range
    Application.ScreenUpdating = False
    t = Timer
    With ActiveSheet ' Sheets("Sheet1")
        LastRow = .Range("P" & .Rows.Count).End(xlUp).Row
        For i = LastRow To 2 Step -1
            If .Range("P" & i).Value < Date - 14 Then
                If r Is Nothing Then
                    Set r = .Range("A" & i)
                Else
                    Set r = Union(r, .Range("A" & i))
                End If
            End If
        Next i
    End With
    r.EntireRow.Delete
    t = Timer - t
    Application.ScreenUpdating = True
    Debug.Print t
End Sub

HansVogelaar

MVP

Dec 24, 2022

Guram_Bregadze

Try this version:

Sub DeleteRows()
    Dim i As Long, LastRow As Long, t As Double, r As Range
    Application.ScreenUpdating = False
    t = Timer
    With ActiveSheet ' Sheets("Sheet1")
        LastRow = .Range("P" & .Rows.Count).End(xlUp).Row
        For i = LastRow To 2 Step -1
            If .Range("P" & i).Value < Date - 14 Then
                If r Is Nothing Then
                    Set r = .Range("A" & i)
                Else
                    Set r = Union(r, .Range("A" & i))
                End If
            End If
        Next i
    End With
    r.EntireRow.Delete
    t = Timer - t
    Application.ScreenUpdating = True
    Debug.Print t
End Sub

Guram_Bregadze
Copper Contributor
Dec 24, 2022
Hi HansVogelaar,

This is the much better version. Thanks a lot!
The only thing is that I had to use 'Date - 21 Then' instead of 14 to delete proper rows. Don't understand why.

Best regards,
Guram
- HansVogelaar
  MVP
  Dec 24, 2022
  Guram_Bregadze
  
  Date - 21 will delete rows older than 3 weeks. Date - 14 would delete rows older than 2 weeks.

Forum Discussion

VBA to delete rows that are older than 14 days

Share

Resources