Check of filter aanstaat met dubbele criteria

[Tweety1]

Onderstaande macro checkt of het filter aanstaat. Alleen weet ik niet hoe ik hier dubbele criteria van kan maken?

Public Sub Test()
If ShowFilter(Columns(1)) = "=1" Then
    MsgBox "Filter staat aan"
Else
    MsgBox "Filter staat uit."
End If
End Sub


Public Function ShowFilter(Rng As Range)
Dim oFilter As Filter
Dim sCriteria1 As String
Dim sCriteria2 As String
Dim sOperator As String
Dim nOp As Long
Dim nOff As Long
Dim rngFilter As Range
Dim sh As Worksheet

    Set sh = Rng.Parent
    If sh.FilterMode = False Then
        ShowFilter = "No Active Filter"
        Exit Function
    End If
    Set rngFilter = sh.AutoFilter.Range

    If Intersect(Rng.EntireColumn, rngFilter) Is Nothing Then
        ShowFilter = CVErr(xlErrRef)
    Else
        nOff = Rng.Column - rngFilter.Columns(1).Column + 1
        If Not sh.AutoFilter.Filters(nOff).On Then
            ShowFilter = "No Conditions"
        Else
            Set oFilter = sh.AutoFilter.Filters(nOff)
            On Error Resume Next
            sCriteria1 = oFilter.Criteria1
            sCriteria2 = oFilter.Criteria2
            nOp = oFilter.Operator
            sOperator = ""
            If nOp = xlAnd Then
                sOperator = " And "
            ElseIf nOp = xlOr Then
                sOperator = " Or "
            End If
            ShowFilter = sCriteria1 & sOperator & sCriteria2
        End If
    End If
End Function

mvg

Kasper

 

[snb]

Zoek eens in de hulpbestanden van de VBEditor op 'autofiltermode'

 

[VenA]

Je kan deze proberen.

Sub Testopfilter()
    On Error GoTo Fout
    Lr = ActiveSheet.AutoFilter.Range.Row
    Application.EnableEvents = False
    For Each flt In ActiveSheet.AutoFilter.Filters
        i = i + 1
        If flt.On Then s = s & Mid(Cells(Lr, i).Address, InStr(Cells(Lr, i).Address, "$") + 1, InStr(2, Cells(Lr, i).Address, "$") - 2) & " , "
     Next
     MsgBox Left(s, Len(s) - 2)
     Application.EnableEvents = True
     Exit Sub
Fout:
     MsgBox ("geen filter")
End Sub

Is niet helemaal van mijn hand

 

[Tweety1]

Bedankt voor het meedenken.

Ik heb het kunnen oplossen door deze regel te veranderen

If ShowFilter(Columns(1)) = "=1" Then

Naar

If ShowFilter(Columns(1)) = "=1 Or =2" Then