VBA Auto Filter If Criteria Exists

Question

I've recorded macros to autofilter and delete rows from a table. But this is not dynamic in the sense that if the filter criteria does not exist in a given table then the macro will break.

I am trying to create a code that will autofilter and delete the rows if the the criteria exists or otherwise do nothing. I am trying to follow this post, but I am missing something. Please help.

My code returns no errors, but also does not do anything. I added the message box to make sure that it was actually running.

Here is my code so far:

Sub autofilter()

Dim lo As ListObject

    Set lo = Worksheets("BPL").ListObjects("Table1")
   
    
With Sheets(1)
    If .AutoFilterMode = True And .FilterMode = True Then
        If lo.Parent.autofilter.Filters(7).Criteria1 = "APGFORK" Then
            '
    lo.Range.autofilter Field:=7, Criteria1:="APGFORK"
    
    Application.DisplayAlerts = False
       lo.DataBodyRange.SpecialCells(xlCellTypeVisible).Delete
    Application.DisplayAlerts = True
    
    lo.autofilter.ShowAllData
            '
        End If
    End If
End With

MsgBox ("Code Complete")

End Sub

Answer 1

Delete Filtered Rows in an Excel Table

• Not entire rows!

Option Explicit

Sub DeleteFilteredRows()
   
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code

    Dim tbl As ListObject: Set tbl = wb.Worksheets("BPL").ListObjects("Table1")
   
    Dim dvrg As Range ' Data Visible Range
   
    With tbl
        If .ShowAutoFilter Then
            If .Autofilter.FilterMode Then .Autofilter.ShowAllData
        End If 
        .Range.Autofilter 7, "APGFORK"
        On Error Resume Next
            Set dvrg = tbl.DataBodyRange.SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
        .Autofilter.ShowAllData
    End With
    
    Dim IsSuccess As Boolean

    If Not dvrg Is Nothing Then
        dvrg.Delete xlShiftUp
        IsSuccess = True
    End If
    
    If IsSuccess Then
        MsgBox "Data deleted.", vbInformation
    Else
        MsgBox "Nothing deleted.", vbExclamation
    End If

End Sub

Answer 2

I don't know if it is a bug or a feature, but .AutoFilterMode seems to returns False all the time in Excel 2013 or later. All examples I see that use .AutoFilterMode are earlier than that.
I think the replacement is .ShowAutoFilter on the listobject. In your code, lo.ShowAutoFilter should return True or False depending on whether or not the autofilter is set or not.

But the rest of your code seems problematic too. The test If lo.Parent.autofilter.Filters(7).Criteria1 = "APGFORK" Then throws an error and removes the autofilter.

Answer 3

I Ended up taking a different approach:

Dim LastRowG As Long
LastRowG = Range("G" & Rows.Count).End(xlUp).Row

For i = 2 To LastRowG
If Range("G" & i).Value = "APGFORK" Then

    lo.Range.autofilter Field:=7, Criteria1:="APGFORK"
    
    Application.DisplayAlerts = False
       lo.DataBodyRange.SpecialCells(xlCellTypeVisible).Delete
    Application.DisplayAlerts = True
    
    lo.autofilter.ShowAllData
    Else
    End If

Next i

This way if "APGFORK" does not exist in a data set, it will move on without an error code.

Answer 4

Try this code

Sub Test()
    Call DelFilterParam("BPL", "Table1", 7, "APGFORK")
End Sub

Sub DelFilterParam(ByVal wsName As String, ByVal stTable As String, ByVal iField As Integer, ByVal vCriteria As Variant)
    Dim x As Long, y As Long, z As Long
    With ThisWorkbook.Worksheets(wsName)
        With .ListObjects(stTable).DataBodyRange
            x = .Rows.Count: y = .Columns.Count
            .AutoFilter
            .AutoFilter Field:=iField, Criteria1:=vCriteria
            On Error Resume Next
                z = .SpecialCells(xlCellTypeVisible).Count
            On Error GoTo 0
            If (x * y) > z And z <> 0 Then .EntireRow.Delete
            .AutoFilter
        End With
    End With
End Sub