VBA to delete rows that are older than 14 days

[Guram_Bregadze]

I have the following VBA to delete rows with data entered 14 days ago. 

The problem with it is that it takes up to 5 seconds for the script to run.

Question: is there a way to speed it up?

I have tried tips from the link below. Doesn't help.

https://eident.co.uk/2016/03/top-ten-tips-to-speed-up-your-vba-code/

Sub DeleteRows()

Dim i As Long, LastRow As Long

Application.ScreenUpdating = False

With Sheets("Sheet1")
LastRow = .Cells(.Rows.Count, "P").End(xlUp).Row

For i = LastRow To 2 Step -1
If DateDiff("d", .Range("P" & i).Value, Date) > 20 Then
.Rows(i).Delete
End If
Next i
End With

Application.ScreenUpdating = True

End Sub

Best regards,

Guram

[#2 · Accepted solution]

@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

[#3]

Hi @Hans Vogelaar,

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

[#4]

@Guram_Bregadze 

Date - 21 will delete rows older than 3 weeks. Date - 14 would delete rows older than 2 weeks.