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

Question

I have an Excel table 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 routines are:

 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 

Sub can be performed as follows:

 Dim tbl As ListObject Set tbl = ThisWorkbook.Worksheets("Sheet1").ListObjects("tblFruits") Call deleteTableRowsBasedOnCriteria(tbl, "Fruit", "Apple") 

Answer 2

Well, it looks like the .listrows property is limited to either ONE line of the list, or ALL lines of the list.

The easiest way I've found this is:

• Setting up a column with a formula that will point me to all the lines that I would like to eliminate (in this case, you may not need a formula)

• Sort listobject in this particular column (it is advisable to have my value to be deleted be at the end of the sort)

• I will remove the list range address

• Finally, deleting the resulting range by moving the cells up.

In this particular 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 likely a better/cleaner way to do that. NoRemoveFound: End With End sub 

Hope this helps ...