Delete Rows from a Worksheet much faster

Question

I've almost done a macro which helps me delete unnecessary rows from a worksheet, the problem is that it takes around 10 min. when I run it since I looking for 4,000 records and filter them so I will only have around 500 records.

This is the code I've been using now:

Dim RuleCode As Range, i As Long
Set RuleCode = Worksheets("Line").Range("D5", Range("D5").End(xlDown))


For i = RuleCode.Count To 1 Step -1
  Select Case RuleCode.Cells(i)
        Case "AD001", "AD002", "AD010", "AD015", "AD031", "AD005", "AD035", "AD100", "AD107", "AD108", "AD152", "AD173", "CO017", "CO081", "CO102", "CO035", "CO169", _
         "CR003", "CR032", "CR070", "GE006", "GE010", "GE012", "GE028", "GE033", "GE035", "GE038", "GE039", "GE040", "GE041", "GE048", "GE066", "GE067", _
         "GE069", "GE073", "GE074", "GE085", "GE092", "GE097", "GE116", "NA023", "NA056", "NA059", "NA061", "NA020", "NA040", "NA055", "NA063", "NA090", _
         "NA101", "NA131", "NA135", "NA192", "NA197", "NA198", "NA209", "NA016", "NA042", "NA044", "NA048", "NA065", "NA123", "NA130", "NA174", "NA280", _
         "NA291", "PO358"

        Case Else
            RuleCode.Cells(i).EntireRow.Delete
    End Select
Next i

This code helps me, but as I said, it takes around 10 min. to finish, so I've trying another method. All those codes are in a list in another Worksheet but I don't know how to do the same referencing that list. This is what I was trying:

Dim RuleRange As Range
Set RuleRange = Worksheets("List").Range("C2:C68")
Dim RuleCode As Range, i As Long
Set RuleCode = Worksheets("Line").Range("D5", Range("D5").End(xlDown))

For i = RuleCode.Count To 1 Step -1
    If RuleCode Is Not RuleRange Then
        RuleCode.Cells(i).EntireRow.Delete
    End If
Next i

Thank you very much in advance

UPDATE 1: This is how my sheet looks like. The Table is a table (Object). When I click the button, the macro runs

[Possibly useful](https://stackoverflow.com/questions/30959315/excel-vba-performance-1-million-rows-delete-rows-containing-a-value-in-less). `If RuleCode Is Not RuleRange`... no, this won't work as is. The real performance problem is that you're deleting row by row. — BigBen, Jan 23 '20 at 13:53
@BigBen Yes, I know, so I was looking for a Faster way. Ron's idea might work, so I'll try if I can do something like that :) — Dark161000, Jan 23 '20 at 13:59
Or build a selection and then delete the selection? The selection or filter lets excel optimise the delete somewhat. — Gem Taylor, Jan 23 '20 at 14:00
@GemTaylor I think it won't work since it might appear new values in the filter that I haven't add. So I tried autofilter, but it won't work because the array won't let me choose "not equal". — Dark161000, Jan 23 '20 at 14:45
I used the list in your code as the criteria array in a filter; using test data with 4k rows, it filtered the list and deleted the rows using `SpecialCells(xlCellTypeVisible)` in about 5 seconds. — GMalc, Jan 23 '20 at 17:00
@GMalc how did you do that? I'm still having problems to do it. I'm using BibBen's link to do it quickly. — Dark161000, Jan 23 '20 at 17:30

score 0 · Answer 1 · edited Jan 23 '20 at 18:10

One way to make it faster is to only clear the cells i D, sort on column D so the empty cells is in the buttom, and then delete entirerows where D is empty.

Here is an example you could modify to your needs

Sub checkrules()
    Application.ScreenUpdating = false
    Dim RuleCode As Range, i As Long, AllTable As Range, lastrow As Long
     'find the last row. needed in the last loop
    lastrow = Worksheets("Line").Range("D5").End(xlDown).Row
    Set RuleCode = Worksheets("Line").Range("D5", Range("D" & lastrow))
    'AllTable is needed to sort
    Set AllTable = Worksheets("Line").Range("D5").CurrentRegion

    For i = 1 To RuleCode.Count                   ' To 1 Step -1
        Select Case RuleCode.Cells(i)
            Case "AD001", "AD002", "AD010", "AD015", "AD031", "AD005", "AD035", "AD100", "AD107", "AD108", "AD152", "AD173", "CO017", "CO081", "CO102", "CO035", "CO169", _
                 "CR003", "CR032", "CR070", "GE006", "GE010", "GE012", "GE028", "GE033", "GE035", "GE038", "GE039", "GE040", "GE041", "GE048", "GE066", "GE067", _
                 "GE069", "GE073", "GE074", "GE085", "GE092", "GE097", "GE116", "NA023", "NA056", "NA059", "NA061", "NA020", "NA040", "NA055", "NA063", "NA090", _
                 "NA101", "NA131", "NA135", "NA192", "NA197", "NA198", "NA209", "NA016", "NA042", "NA044", "NA048", "NA065", "NA123", "NA130", "NA174", "NA280", _
                 "NA291", "PO358"

            Case Else
            'only clear
                RuleCode.Cells(i).ClearContents
        End Select
    Next i
    'sort the table on D so empty cells is in the buttom
    With ActiveWorkbook.Worksheets("Line").Sort
        .SortFields.Clear
        .SortFields.Add2 Key:=RuleCode, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange AllTable
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    'Delete all rows where D is blank
    For i = lastrow To 5 Step -1
        If IsEmpty(Range("D" & i)) Then Range("D" & i).EntireRow.Delete
    Next
    Application.ScreenUpdating = true
    MsgBox "Finito", vbInformation
End Sub

I tried your code but it takes so long and I'm not pretty sure it does what I want — Dark161000, Jan 23 '20 at 15:55
It can't be that slow on only 4000 rows. It should complete within a couple of seconds. Try to put these lines in the start of the code Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False and this in the end Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True Application.ScreenUpdating = True — Bak, Jan 23 '20 at 16:17

GMalc · Answer 2 · 2020-01-24T21:52:42.667

0

Edited per OP clarification in comments...

Code uses IsError to test values in array. It will delete rows if cells value in not in array. Takes about 5 seconds.

Sub DelRowIfNotInArray()
Dim arr As Variant, ws As Worksheet, iRow As Long
Set ws = ThisWorkbook.Sheets("Line")

Application.ScreenUpdating = False

arr = Array("AD001", "AD002", "AD010", "AD015", "AD031", "AD005", "AD035", "AD100", "AD107", "AD108", _
        "AD152", "AD173", "CO017", "CO081", "CO102", "CO035", "CO169", "CR003", "CR032", "CR070", _
        "GE006", "GE010", "GE012", "GE028", "GE033", "GE035", "GE038", "GE039", "GE040", "GE041", _
        "GE048", "GE066", "GE067", "GE069", "GE073", "GE074", "GE085", "GE092", "GE097", "GE116", _
        "NA023", "NA056", "NA059", "NA061", "NA020", "NA040", "NA055", "NA063", "NA090", "NA101", _
        "NA131", "NA135", "NA192", "NA197", "NA198", "NA209", "NA016", "NA042", "NA044", "NA048", _
        "NA065", "NA123", "NA130", "NA174", "NA280", "NA291", "PO358")

    For iRow = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row To 5 Step -1
        If IsError(Application.Match(ws.Cells(iRow, 5).Value, arr, 0)) Then
            ws.Cells(iRow, 5).EntireRow.Delete
        End If
    Next iRow

Application.ScreenUpdating = True
End Sub

edited Jan 24 '20 at 21:52

answered Jan 23 '20 at 17:51

GMalc

2,608
1
9
16

I tried and it only filters, but doesn't not delete the unnecessary rows or am I missing something? – Dark161000 Jan 23 '20 at 18:16
@Dark161000 please clarify; i thought you were trying to filter these values in column D and delete the visible rows, like the first code you said was working but too slowly? What do you mean by unnecessary rows? I thought your list identified the unnecessary rows. – GMalc Jan 23 '20 at 18:24
The code I posted deletes any row that does NOT contain those codes I wrote. Since it checks cell by cell, it takes long time. I added `RuleCode.Cells(i).EntireRow.Delete` almost at the end of my codes, so you see I delete not wanted rows. – Dark161000 Jan 23 '20 at 18:28
@Dark161000 to delete hidden rows in a filtered range, you have to loop through each row and use `Union` to combine all the hidden rows and delete them at the same time. Or, If you had a list of the criteria that you don't want to keep, then use that list to filter and delete the visible data. – GMalc Jan 23 '20 at 19:48

Delete Rows from a Worksheet much faster

2 Answers2