Deleting all rows containing a specific value (most efficient method?)

Question

Hi there I am trying to write a macro that processes a huge file (talking 30-35k rows). I have a loop that goes through all the cells in column A and deletes all rows where the date in column A doesn't equal yesterday's date. (sounds convoluted I know). Is there any more efficient way of doing this? I mean the loop works but it frequently crashes excel and times out etc.

Sub PSAudit()
Dim Auditdate As String
Dim rng As Range
Dim psm as worksheet

Set psm = Sheets("PS_MAIN")
Application.ScreenUpdating = False

        Auditdate = Format(Date - 1, "yyyy-mm-dd")

    lastrow = Cells(Rows.Count, "A").End(xlUp).Row
    For x = 1 To lastrow

        If psm.Range("A" & x).Value <> Auditdate Then psm.Range("A" & x).EntireRow.Delete

    Next x


Application.ScreenUpdating = True


End Sub

When deleting rows, start at the bottom and work your way up : `For x = lastrow To 1 Step -1` — CLR, Apr 18 '18 at 11:51
@Rhyfelwr It would definetely delete all rows correctly at least. — AntiDrondert, Apr 18 '18 at 11:51
*...the loop works but it frequently crashes excel and times out...* IF it crashes, try using `DoEvents` after deleting. Type it right after your IF and test it. Also, disabling calculations with `Application.Calculation = xlCalculationManual` will help — Foxfire And Burns And Burns, Apr 18 '18 at 12:01
No headers it is just a raw logging file with an event with a corresponding date in each row — Rhyfelwr, Apr 18 '18 at 12:15
This answer is a lot faster: [Excel VBA Performance - 1 million rows - Delete rows containing a value, in less than 1 min](https://stackoverflow.com/a/30959316) — paul bica, Apr 18 '18 at 14:44
Wow that is actually very interesting. I guess this is the limitation of VBA when users have to use workarounds like that. — Rhyfelwr, Apr 18 '18 at 14:58

Pspl · Answer 1 · 2018-04-18T12:01:39.720

1

I would do the following:

Sub PSAudit()
    Dim psm As Worksheet
    Set psm = ThisWorkbook.Sheets("PS_MAIN")
    Dim LastRow As Long
    Dim Auditdate As String
    Auditdate = Format(Now() - 1, "yyyy-mm-dd")
    Application.Calculation = xlCalculationManual
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row
    For x = LastRow To 1 Step -1
        If psm.Cells(x, 1).Value <> Auditdate Then
            psm.Cells(x, 1).EntireRow.Delete
        End If
        DoEvents
    Next x
    Application.Calculation = xlCalculationAutomatic
End Sub

Explanation: First, when you use a for nextto delete rows (or columns) start from the bottom. Second, if you place a DoEventson the procedure, your file doesn't crash. And third, using complete cells addresses gives you liberty to work on your file (even on other sheets) or even on another workbooks while your script is running.

edited Apr 18 '18 at 12:01

answered Apr 18 '18 at 11:53

Pspl

1,398
12
23

upvoted for looping the rows backwards, thus avoiding deleting rows that should not be deleted – Ahmad Apr 18 '18 at 11:55
Parent object of `Cells` is not specified, as well as for `Rows`. `Application.ScreenUpdating = False/True` applies better for this procedure than `Application.Calculation`, unless OP has tons of formulas in worksheet. – AntiDrondert Apr 18 '18 at 11:55
Hmm I'm sorry but this one is even slower than my original code, although it does work! – Rhyfelwr Apr 18 '18 at 11:57
But you file stays editable while macro's running... Right? – Pspl Apr 18 '18 at 11:58
2

@Rhyfelwr because it evokes `Format(Now()),"SomeFormat")` for each cell it checks. – AntiDrondert Apr 18 '18 at 11:58
Right! Keeping `Auditdate` variable it's better... I didn't test the script... (edited already)... – Pspl Apr 18 '18 at 11:59

CLR · Accepted Answer · 2018-04-18T12:05:05.460

1

You need to start at the bottom as once a row is deleted, your index is out by one row. You also should really qualify the sheet for your LastRow query. Nor sure why you declare rng as you don't use it. Lastly, I'd turn off calculation if the workbook contains any formulae.

Sub PSAudit()

    Dim Auditdate As String
    Dim psm As Worksheet

    Set psm = Sheets("PS_MAIN")
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Auditdate = Format(Date - 1, "yyyy-mm-dd")

    lastrow = psm.Cells(Rows.Count, "A").End(xlUp).Row

      For x = lastrow To 1 Step -1
          With psm.Range("A" & x)
              If .Value <> Auditdate Then .EntireRow.Delete
          End With
      Next x

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub

edited Apr 18 '18 at 12:05

answered Apr 18 '18 at 11:58

CLR

11,284
1
11
29

Well this one seems the fastest and the most stable so I'll use your solution, it still takes a good 7-8 minutes to run the loop through the file but I guess I'll have to live with it haha. Thanks for the help! – Rhyfelwr Apr 18 '18 at 12:33
Out of interest.. is your source table sorted in any particular order? – CLR Apr 18 '18 at 13:29
It is sorted by date ascending by default – Rhyfelwr Apr 18 '18 at 13:34
1

If you're talking about column A, then you could speed things up **a lot** by finding the top and bottom of the block to delete and delete that entire block as one command. – CLR Apr 18 '18 at 14:02

AntiDrondert · Answer 3 · 2018-04-18T19:17:09.753

Expanding @ingwarus answer, it is faster to delete all rows at once, given their address.

Sub PSAudit()
    Dim Auditdate As String
    Dim rng As Range
    Dim psm As Worksheet
    Dim vArr(), i As Long
    Dim auStart As Long, auEnd As Long

    DisFun False

    Set psm = ThisWorkbook.Worksheets("PS_MAIN")
    Auditdate = Format(Date - 1, "yyyy-mm-dd")
    Set rng = psm.Range("A1:D" & Range("A" & psm.Rows.Count).End(xlUp).Row)
    'Set rng = psm.Range("A1").CurrentRegion
    rng.Sort rng.Cells(1, 1), xlAscending, , , , , , xlNo
    vArr = Application.Transpose(rng.Columns("A").Value)
    For i = LBound(vArr) To UBound(vArr)
        If vArr(i) = Auditdate Then auStart = i: Exit For
    Next i
    For i = UBound(vArr) To LBound(vArr) Step -1
        If vArr(i) = Auditdate Then auEnd = i: Exit For
    Next i
    Select Case True
        'Auditdate is at start
        Case auStart = 1
            psm.Range(auEnd + 1 & ":" & UBound(vArr)).EntireRow.Delete
        'Auditdate is at the end
        Case auEnd = UBound(vArr)
            psm.Range("1:" & auStart - 1).EntireRow.Delete
        'Auditdate in between
        Case Else
            psm.Range("1:" & auStart - 1 & "," & auEnd + 1 & ":" & UBound(vArr)).EntireRow.Delete
    End Select

    DisFun True

End Sub

Firstly of all, we need to define the range and sort it.
Secondly, we need to find first and last occurence of AuditDate.
Depending on auStart and auEnd values, we can narrow down certain situations and delete rows accordingly.
I've used help sub one can find useful in later projects:

Private Sub DisFun(ByVal Status As Boolean)
    With Application
        .ScreenUpdating = Status
        .EnableEvents = Status
        .DisplayStatusBar = Status
        .Calculation = IIf(Status, -4105, -4135)
    End With
End Sub

FreeMan · Answer 4 · 2018-04-18T12:55:51.827

Using .Find() is always significantly faster than looping through all rows (for all but trivial numbers of rows).

This is untested but should get you started. You'll probably have to tweak the What:="" parameter a bit and play around with that. It's much easier when you're searching for something specific than searching for what's not that specific thing. I'd suggest refining your search using the dialog box to determine exactly what you need to put in the What:="" parameter.

Remember that .Find() will use all search settings that are defined in the UI dialog box unless you specify them in your code, and changing them in code will change what you see in the dialog box, too.

Private Sub PSAudit()

  On Error GoTo cleanExit
  Dim auditDate As Date
  auditDate = Date

  Dim previousCalculation As Long
  previousCalculation = Application.Calculation
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual

  Dim psm As Worksheet
  Set psm = ActiveWorkbook.Worksheets("PS_MAIN")
  Dim searchRange As Range
  Set searchRange = psm.Columns("A")

  Dim oldDates As Range
  Set oldDates = psm.Columns.Find(What:="< auditDate", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns)

  If not oldDates is Nothing then
    Dim deleteRow As Range
    For Each deleteRow In oldDates
      deleteRow.EntireRow.Delete
    Next
 End If

cleanExit:
  Application.ScreenUpdating = True
  Application.Calculation = previousCalculation

End Sub

Turning off .ScreenUpdating and .Calculation, as mentioned by others, will improve processing times somewhat, but .Find() will be the big hitter.

Probably because I declared `auditDate` as a `Date` and you're using it (elsewhere) as a string. Frankly, you could skip using `auditDate` in the `.Find()` and substitute with `What:=date-1` and it _should_ work depending on how your dates are formatted (are they actual Excel Date formats or are they just text) - that will determine what you need to search for. Also, you can `Dim auditDate as String` and set it to whatever you need, _and_ `Dim searchDate as Date` to use in the `.Find()` method if you want and if that makes things work better — FreeMan, Apr 18 '18 at 12:25
Hmmm I've been trying to specify too exact values to look for (date of the day before yesterday and today's date) as strings to put them after the what:= query but sadly it still doesn't work. Even though according to the debug.print the declared dates to look for are correct. — Rhyfelwr, Apr 18 '18 at 12:28
Sadly, I'm not sure that a formula result can be used in the `.Find()` function, so this probably won't work. However, I'll leave it here as an example of using `.Find()` instead of looping. — FreeMan, Apr 18 '18 at 12:41

score -2 · Answer 5 · answered Apr 18 '18 at 12:06

-2

Deleting row by row will be painfully slow, so you should sort by date and delete all rows at once. It's the fastest way.

answered Apr 18 '18 at 12:06

ingwarus

413
2
11

Deleting all rows containing a specific value (most efficient method?)

5 Answers5