Looping through rows in a ListObject to delete them is very slow

Question

I have a ListObject table with ~500 rows, I've also got 4 values in a named range.

There are maybe 30 unique values that occur repeatedly (At random) for the 500 rows, I want to delete all rows whose values are not in the named range.

I have the following which works, but it is running slower than expected (approximately 2 min):

Sub removeAccounts()

Dim tbl As ListObject
Dim i As Integer

Set tbl = ThisWorkbook.Sheets("TheSheet").ListObjects("TheTable")

i = tbl.ListRows.Count


While i > 0
  If Application.WorksheetFunction.CountIf(Range("Included_Rows"), tbl.ListRows(i).Range.Cells(1).Value) = 0 Then
    tbl.ListRows(i).Delete
  End If
  i = i - 1
Wend

End Sub

I'm not sure whether it's the reliance on the worksheet function or just looping through the rows that is slowing it down.

Is there a way to filter the listobject and discard the rest?

I was thinking of just chucking a progress bar on it so that the users can see something happening...

to improve speed, just minimize interactions with the worksheet... push everything in variables (that means your whole table!) while lining up all items in `Range("Included_Rows")` into a 1d array, then use `Application.Match` to push the ranges as ref into another variable and then delete everything at once... will be ~10-250 times faster at the end (your 500 rows should take ~4-9 seconds with deleting) — Dirk Reichel, Dec 21 '15 at 02:56
If you have formulas that reference the columns in that table either within the table or external to the table, each act of deletion will require recalculation. — , Dec 21 '15 at 04:42
fwiw, adding a progress bar may keep your users entertained but it actually compounds the problem. Better to get the code working efficiently. — , Dec 21 '15 at 04:48
Initially I had started at the first row and added to the iterator each loop, that did skip rows, starting at the bottom and working up solved that. EDIT: I agree wholeheartedly with the progress bar / efficiency comment! — Kieran, Dec 21 '15 at 04:55

Fadi · Accepted Answer · 2015-12-21T02:49:07.773

4

Try this Code:

Sub removeAccounts()

 Dim tbl As ListObject
 Dim i As Long
 Dim uRng As Range

 Application.ScreenUpdating = False
 Application.EnableEvents = False
 Application.Calculation = xlCalculationManual


 Set tbl = ThisWorkbook.Sheets("TheSheet").ListObjects("TheTable")

 i = tbl.ListRows.Count


 While i > 0
   If Application.WorksheetFunction.CountIf(Range("Included_Rows"), tbl.ListRows(i).Range.Cells(1).Value) = 0 Then

      'tbl.ListRows(i).Delete
      If uRng Is Nothing Then
       Set uRng = tbl.ListRows(i).Range
      Else
       Set uRng = Union(uRng, tbl.ListRows(i).Range)
      End If
   End If
   i = i - 1
 Wend

  If Not uRng Is Nothing Then uRng.Delete xlUp

 Application.ScreenUpdating = True
 Application.EnableEvents = True
 Application.Calculation = xlCalculationAutomatic

 End Sub

edited Dec 21 '15 at 02:49

answered Dec 21 '15 at 02:19

Fadi

3,302
3
18
41

1

Change integer to long, rows.count will blow an integer. – Dan Donoghue Dec 21 '15 at 02:41
@DanDonoghue , thank you , but don't want to change the OP code as he ask for fast way , but I will change it now ! – Fadi Dec 21 '15 at 02:48
0.53 Seconds! I'm gonna re-check the other solution as well EDIT: So Jeeped's solution worked as well but is a bit slower @ ~2.x seconds I just realised I can't 'accept' more than one solution, they both work though! – Kieran Dec 21 '15 at 05:43

score 2 · Answer 2 · 2015-12-21T07:51:40.280

Your problem is not so much that you are looping through cells. It is in the fact that you are attempting to delete many discontiguous rows from a table; each one requiring internal reordering and restructuring of the ListObject table. Anything you can do to remove all of the rows at once will help and if you can delete them as a block it would be even better. Additionally, you may be recalculating whole columns of formulas repeatedly and redundantly.

You should find the following a scootch faster.

Sub removeAccounts()

    Dim i As Long

    Debug.Print Timer
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    With ThisWorkbook.Sheets("TheSheet")
        With .ListObjects("TheTable")
            '.Range.Columns(2).Delete
            .Range.Columns(2).Insert
            With .DataBodyRange.Cells(1, 2).Resize(.DataBodyRange.Rows.Count, 1)
                .FormulaR1C1 = "=isnumber(match(RC[-1], Included_Rows, 0))"
                .Calculate
            End With
            .Range.Cells.Sort Key1:=.Range.Columns(2), Order1:=xlDescending, _
                              Orientation:=xlTopToBottom, Header:=xlYes
            With .DataBodyRange
                i = Application.Match(False, .Columns(2), 0)
                Application.DisplayAlerts = False
                .Cells(i, 1).Resize(.Rows.Count - i + 1, .Columns.Count).Delete
                Application.DisplayAlerts = True
            End With
            .Range.Columns(2).Delete
        End With
    End With

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Debug.Print Timer

End Sub

I ran this against 500 rows of sample data (A-Z) with A-D in the Included_Rows named range. It took 0.02 seconds.

How was the time on your data? The VBE's Immediate window (Ctrl+G) should report the start and stop in seconds. — , Dec 21 '15 at 05:29
2.32 seconds, the strings I'm matching are ~ 25 characters. Still what I'd call a dramatic improvement ! — Kieran, Dec 21 '15 at 05:34
That time could likely be improved with the same environment shutdowns suggested by @fadi. As mentioned earlier, I strongly suspect that formula recalculation may be an important factor. See edit above. — , Dec 21 '15 at 07:47

score 0 · Answer 3 · edited May 12 '16 at 15:43

0

Try this:

Dim Tbl As ListObject
Set Tbl = Sheets(indx).ListObjects(Tabla)

With Tbl

If .ListRows.Count >= 1 Then .DataBodyRange.Delete

End With

edited May 12 '16 at 15:43

Matthew Verstraete

6,335
22
67
123

answered May 12 '16 at 15:01

Rjev

1

score 0 · Answer 4 · edited Oct 29 '16 at 23:26

Use code like this to delete all but the first row in a list object. By deleting the entire row, it also resizes the table appropriately. tblData is a ListObject variable pointing to an existing table/listobject.

tblData.DataBodyRange.Offset(1, 0).EntireRow.Delete

Of course, you can't have data to the left or right of a table since it will also be deleted. But this is MUCH faster than looping.

Looping through rows in a ListObject to delete them is very slow

4 Answers4

Linked

Related