Delete Rows based on cell value

[RattlingCarp3048]

I have googled and searched other platforms with no clear answer. hopefully someone here can help!

Currently we are manually filtering column P to display all rows where the date is older than 5 days back, then deleting the entire rows. In an effort to automate this I have modified a VBA code that loops through to do this. The code works fine for smaller volumes of data but is soooooooo slow with larger data. Is there a way to improve the speed of the loop? Is there another method that may work just as well instead of a loop?

worksheet regularly contains 30,000+ rows. Column P is date/time but formatted to display only the date. the # of rows older than 5 days will regularly be 3,000-5,000 rows.

Sub Delete()
'
' Assign worksheets to worksheet variables
Set ws3 = Sheets("Today's Final Report")
' Find last row with data in column P on Current List
lr = ws3.Cells(Rows.Count, "P").End(xlUp).Row
' Loop through all rows on Today's Final Report backwards, up to row 2
For r = lr To 2 Step -1
' See if date in column P > 5
If Date - ws3.Cells(r, "P").Value > 5 Then
' Delete row on sheet 3
ws3.Rows(r).Delete Shift:=xlUp
End If
Next r
Application.ScreenUpdating = True
End Sub

 

[Candyman8019]

One thing you could do is add the following near the top of your sub:
Application.ScreenUpdating = False

 

[Joe4]

Instead of using loops (which can be really slow), you can delete filtered data.

Here are some code that I use that will delete unhidden rows after a filter is done.
So create a filter to hide the rows you wish to keep, then run this code.

Public Sub DeleteUnHiddenRows()
'   Deletes all unhidden rows except for the header (first row only)

    Dim lr As Long
    
'   Find last row in column A with data
    lr = Cells(Rows.Count, "A").End(xlUp).Row

'   Exit sub if no data to delete data (only header visible)
    If lr = 1 Then Exit Sub

'   Delete unhidden data
    Application.DisplayAlerts = False
    ActiveSheet.UsedRange.Offset(1, 0).Resize(ActiveSheet.UsedRange.Rows.Count - 1).Rows.Delete
    Application.DisplayAlerts = True

End Sub

 

[RattlingCarp3048]

Instead of using loops (which can be really slow), you can delete filtered data.

Here are some code that I use that will delete unhidden rows after a filter is done.
So create a filter to hide the rows you wish to keep, then run this code.

Public Sub DeleteUnHiddenRows()
'   Deletes all unhidden rows except for the header (first row only)

    Dim lr As Long
   
'   Find last row in column A with data
    lr = Cells(Rows.Count, "A").End(xlUp).Row

'   Exit sub if no data to delete data (only header visible)
    If lr = 1 Then Exit Sub

'   Delete unhidden data
    Application.DisplayAlerts = False
    ActiveSheet.UsedRange.Offset(1, 0).Resize(ActiveSheet.UsedRange.Rows.Count - 1).Rows.Delete
    Application.DisplayAlerts = True

End Sub

would the auto filter via VBA look like this?

ActiveSheet.Range("P:P").AutoFilter Field:=16, Operator:= _
xlFilterValues, Criteria1:=DateAdd("d", -5, Now)

this did filter column P but did not display any data so i assume there is an error with the way i worded the criteria.

 

[Joe4]

Let Excel do the work for you!
If you turn on your Macro Recorder and record yourself performing the filter manually, then stop the Macro Recorder and look at the code you recorded, you will see what the VBA code for that filter needs to look like.

 

[RattlingCarp3048]

Let Excel do the work for you!
If you turn on your Macro Recorder and record yourself performing the filter manually, then stop the Macro Recorder and look at the code you recorded, you will see what the VBA code for that filter needs to look like.

i think that is where my hang up is! lol if i use the filter > date filter all of the options are static, meaning i have to set a specific date. How do i make that more dynamic to be today - 5?

 

[Joe4]

OK, I thought that the Basic Filter would let you create dynamic formulas, but maybe not. That is OK though, because we can build the dynamic filter in VBA.
Let's say we wanted the filter to be "less than or equal to 5 days prior to today". Then we could do something like this:

'   Build dynamic date filter
    Dim dte As String
    dte = "<" & Date - 5
    MsgBox dte
    
'   Apply filter
    ActiveSheet.Range("P:P").AutoFilter Field:=16, Operator:= _
        xlFilterValues, Criteria1:=dte

Note that the MsgBox is just in there to show you the date filter you are building.
You can remove it when you having it working the way you need.

 

[RattlingCarp3048]

OK, I thought that the Basic Filter would let you create dynamic formulas, but maybe not. That is OK though, because we can build the dynamic filter in VBA.
Let's say we wanted the filter to be "less than or equal to 5 days prior to today". Then we could do something like this:

'   Build dynamic date filter
    Dim dte As String
    dte = "<" & Date - 5
    MsgBox dte
   
'   Apply filter
    ActiveSheet.Range("P:P").AutoFilter Field:=16, Operator:= _
        xlFilterValues, Criteria1:=dte

Note that the MsgBox is just in there to show you the date filter you are building.
You can remove it when you having it working the way you need.

if there is a way to make the basic filter more dynamic i havent found it lol ive been all over the internet and trying tons of different combination methods with no results.

but this worked! i was originally wording the criteria filter incorrectly in the VBA. yours in combination with deleting the rows was soooooo much faster than a loop this is the final code...

'
' Build dynamic date filter
Dim dte As String
dte = "<" & Date - 5
' Apply filter
ActiveSheet.Range("P:P").AutoFilter Field:=16, Operator:= _
xlFilterValues, Criteria1:=dte
'Delete Rows
Rows("2:2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.delete Shift:=xlUp
Selection.AutoFilter
End Sub

 

[Joe4]

You are welcome.
Glad I was able to help!