How to delete rows in an Excel ListObject based on criteria using VBA? - excel

Question

I have a table in Excel called tblFruits with 10 columns and I want to delete any rows where the Fruit column contains Apple. How can I do this?

Answer 1

The following sub works:
Private Sub deleteTableRowsBasedOnCriteria(tbl As ListObject, columnName As String, criteria As String)
Dim x As Long, lastrow As Long, lr As ListRow
lastrow = tbl.ListRows.Count
For x = lastrow To 1 Step -1
Set lr = tbl.ListRows(x)
If Intersect(lr.Range, tbl.ListColumns(columnName).Range).Value = criteria Then
'lr.Range.Select
lr.Delete
End If
Next x
End Sub
The sub can be executed like this:
Dim tbl As ListObject
Set tbl = ThisWorkbook.Worksheets("Sheet1").ListObjects("tblFruits")
Call deleteTableRowsBasedOnCriteria(tbl, "Fruit", "Apple")

Answer 2

Well, it seems the .listrows property is limited to either ONE list row or ALL list rows.
Easiest way I found to get around this was by:
Setting up a column with a formula that would point out to me all rows I would like to eliminate (you may not need the formula, in this case)
Sorting the listobject on that specific column (preferably making it so that my value to be deleted would be at the end of the sorting)
Retrieving the address of the range of listrows I will delete
Finally, deleting the range retrieved, moving cells up.
In this specific piece of code:
Sub Delete_LO_Rows
Const ctRemove as string = "Remove" 'value to be removed
Dim myLO as listobject, r as long
Dim N as integer 'number of the listcolumn with the formula
Set myLo = Sheet1.ListObjects("Table1") 'listobject goes here
With myLO
With .Sort
With .SortFields
.Clear
.Add Key:=.HeaderRowRange(myLO.ListColumns(N)), SortOn:= _
xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
End With
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
On Error GoTo NoRemoveFound
r = Application.WorksheetFunction.Match(ctRemove, .ListColumns(.ListColumns.Count).DataBodyRange, 0)
Range(.parent.name & "!" & .DataBodyRange(r, 1).Address & ":" & .DataBodyRange(.ListRows.Count, .ListColumns.Count).Address).Delete xlShiftUp
'Added the .parent.name to make sure the address is on the correct sure, but it will fail if there are any spaces or characters on the sheet name that will make it need a pair of '.
'The error is just to skip these two lines in case the match returns an error. There's likely a better/cleaner way to do that.
NoRemoveFound:
End With
End sub
Hope it helps...