Finding Selected Criteria in AutoFilter

[littleiitin]

Hi,

Some time in codes we want to check what all options we have passed in autofilter.

Below is the Code to Get the Selected Options.

You can just change your Filter Range to get the desired result.

Sub FindFilterOption()
    
    Dim rngFilter       As Range
    Dim strCriteria     As String
    Dim rngToCheck      As Range
    With Sheet1
        '=========Set Accordingly =========================
        Set rngFilter = .Range("A1").CurrentRegion
        Set rngToCheck = rngFilter.Columns(1)
        '========================;=========================
        If .AutoFilterMode = True Then
            
            strCriteria = FindAutoFilterCriteria(rngToCheck)
            MsgBox Replace(strCriteria, "=", "")
        End If
    End With
End Sub

Function FindAutoFilterCriteria(rngHeader As Range) As String

    Dim strCri1     As String
    Dim strCri2     As String
    Dim strVar      As Variant


    Application.Volatile

    With rngHeader.Parent.AutoFilter

        With .Filters(rngHeader.Column - .Range.Column + 1)

            If Not .On Then Exit Function
            On Error Resume Next
            strCri1 = .Criteria1
            If Err.Number <> 0 Then
                strVar = .Criteria1
                strCri1 = Join(strVar, ";")
                Err.Clear: On Error GoTo 0
            End If
            On Error Resume Next
            If .Operator = xlAnd Then

                strCri2 = " AND " & .Criteria2
                If Err.Number <> 0 Then
                    strVar = .Criteria2
                    strCri2 = "AND " & Join(strVar, ";")
                End If
            ElseIf .Operator = xlOr Then

                strCri2 = " OR " & .Criteria2
                If Err.Number <> 0 Then
                    strVar = .Criteria2
                    strCri2 = " OR " & Join(strVar, ";")
                End If
            End If
            Err.Clear: On Error GoTo 0

        End With
    End With
    FindAutoFilterCriteria = "Criteria Applied in Range " & UCase(rngHeader.Address) & ": " & strCri1 & strCri2

End Function

Thanks
Rahul Singh