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