Looping through rows in a ListObject to delete the

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...

Answer 1

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

Answer 2

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.

Answer 3

Try this:

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

With Tbl

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

End With

Answer 4

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.