Finding the status of arbitrarily applied autofilt

Question

I wanted to give something back.

Recently answered/re-asked in This question:

I found the solution to my problem.

Here is a VBA function which returns the status of an AutoFilter as a string.

You pass it the NAME of a table which appears somewhere on a worksheet. There can be more than one, and the function "finds" the appropriate one.

I was having a problem where if the Active Cell was NOT in the selected table, it would fail. The solution was to match the table address with all tables on the sheet in question.

So far, it works. Have tried in multiple ways.

Anyway, I thought I'd try to share it back to the community, since I found several related posts which helped to build this up.

Here it is:

 Public Function AutoFilterCriteria(ByVal WholeTable As Range) As String

On Error Resume Next

Dim ThisAutoFilter As AutoFilter, iObj As Integer, Found As Boolean
Found = False
For iObj = 1 To WholeTable.Parent.ListObjects.Count
    If WholeTable.Address = WholeTable.Parent.ListObjects(iObj).DataBodyRange.Address Then
        Set ThisAutoFilter = WholeTable.Parent.ListObjects(iObj).AutoFilter
        Found = True
        Exit For
    End If
Next

If Not Found Then
    AutoFilterCriteria = "Not Found !!!"
    On Error GoTo 0
    Exit Function
ElseIf ThisAutoFilter Is Nothing Then                     ' if no filter is applied
    AutoFilterCriteria = "None"
    On Error GoTo 0
    Exit Function
End If

Dim LongStr As String, FirstOne As Boolean
LongStr = ""
FirstOne = False

Dim iFilt As Integer
For iFilt = 1 To ThisAutoFilter.Filters.Count         ' loop through each column of the table
    Dim ThisFilt As Filter
    Set ThisFilt = ThisAutoFilter.Filters(iFilt)      ' look at each filter
    On Error Resume Next
    With ThisFilt
        If .On Then
            If FirstOne Then LongStr = LongStr & " AND "            ' Get colun title
            LongStr = LongStr & "[" & WholeTable.Parent.Cells(WholeTable.Row - 1, WholeTable.Column + iFilt - 1).Value & ":"
            On Error GoTo Handle
            If .Operator = xlFilterValues Then                      ' for multiple, loop thru each one
                Dim iCrit As Integer
                For iCrit = 1 To UBound(ThisFilt.Criteria1) - 1
                    LongStr = LongStr & .Criteria1(iCrit) & " OR "
                Next
                LongStr = LongStr & .Criteria1(UBound(ThisFilt.Criteria1)) & "]"    ' the last one doesn't get the "OR"
            ElseIf .Operator = 0 Then
                LongStr = LongStr & .Criteria1 & "]"
            ElseIf .Operator = xlAnd Then
                LongStr = LongStr & .Criteria1 & " AND " & .Criteria2 & "]"
            ElseIf .Operator = xlOr Then
                LongStr = LongStr & .Criteria1 & " OR " & .Criteria2 & "]"
            End If
            On Error GoTo 0
            FirstOne = True
        End If
    End With
Next

AutoFilterCriteria = LongStr
On Error GoTo 0
Exit Function

Handle:
AutoFilterCriteria = "! Error !"
On Error GoTo 0

End Function

You can use this in a formula on a worksheet list this: =AutoFilterCriteria(some_named_table)

You can use this in code like this:

Dim S as String S=AutoFilterCriteria(ActiveSheet.ListObjects("some_named_table").DataBodyRange)

Output is similar to : [Column1:=b OR =d OR =e] AND [Column 4:=11]

I hope that someone else might find it useful. Cheers!