Home » excel » excel – VBA: Return more than 2 filter criterias

excel – VBA: Return more than 2 filter criterias

Posted by: admin May 14, 2020 Leave a comment

Questions:

I am having a standard filter on a bunch of columns and i want to read the filter criterias. This wasn’t really a problem until the case where more than 2 criteria are selected. I have a row with different strings and i want do be able to get the criteria the user has chosen. Currently I am working with this piece of code:

Set ws = Worksheets(actSheet)
For Each flt In ws.AutoFilter.Filters
    If flt.On = True Then
        criterias = criterias & flt.Criteria1 & ", "
        criterias = criterias & flt.Criteria2 & ", "
    End If
Next flt

This only gives me the opportunity to get 2 Criteria max.
I have found this line of code in different forums, but it was used for other reasons and i do not really know how to use this code for me:

ActiveSheet.AutoFilter Field:=1, Criteria1:=Array(param1, param2, param3,...) _
                       Operator:=xlFilterValues

This way you can set criteria i think, but i want to get it.
Any ideas how i can use this code? Or another suggestion for my problem?

Thanks in advance!


Edit:

Well i’ve worked a lot of hours on this and still no Solution. It is not really possible to get the Array in Criteria1 in an Array. Always the same Error “Can not assign to array”. Although i assigned the same array to the Filter Criteria1 10 lines of code before…

So this works:

Dim arr(3) As String
arr(2) = "test1"
arr(1) = "test2"
arr(3) = "test3"

ActiveSheet.Range("A1:C1").AutoFilter Field:=1, Criteria1:=arr, Operator:=xlFilterValues

But this doesn’t:

arr = ws.AutoFilter.Filters.Criteria1
How to&Answers:

Edit2: This gets the filters and it’s headers

Sub GetFilteredItems()
    Dim fl As Filter
    Dim ws As Worksheet: Set ws = ActiveSheet
    Dim i As Long: i = 0
    Dim myfilters As String

    For Each fl In ws.AutoFilter.Filters
        If fl.On Then
            If Len(myfilters) = 0 Then
                myfilters = ws.AutoFilter.Range.Offset(0, i).Resize(1, 1).Value
            Else
                myfilters = myfilters & "; " & _
                    ws.AutoFilter.Range.Offset(0, i).Resize(1, 1).Value
            End If
            If fl.Count > 2 Then
                myfilters = myfilters & ": " & Replace(Join(fl.Criteria1), "=", "")
            Else
                myfilters = myfilters & ": " & Replace(fl.Criteria1, "=", "")
                On Error Resume Next
                myfilters = myfilters & " " & Replace(fl.Criteria2, "=", "")
                On Error GoTo 0
            End If
        End If
        i = i + 1
    Next
    Debug.Print myfilters
End Sub

I remove other codes to avoid confusing the reader.
This is much like the OP’s approach but a little bit direct. HTH.

Answer:

Finally i found an answer!

The issue was not too big, just really hard to get an answer on this because you nearly don’t find anything on the internet.

Dim criterias As String
Dim arr As Variant

For Each flt In ws.AutoFilter.Filters
If flt.On = True Then
    'write the column head in the string
    criterias = criterias & "=" & _ 
    ws.AutoFilter.Range.Offset(0, i - 1).Resize(1, 1).Value & ": "
    If flt.Count > 2 Then
        arr = flt.Criteria1                   '<----- my problem
        For i = LBound(arr) To UBound(arr)    '<-----
            criterias = criterias & arr(i)    '<-----
        Next                                  '<-----
    Else
        criterias = criterias & flt.Criteria1
        On Error Resume Next
        criterias = criterias & flt.Criteria2 & ", "
    End If

End If
i = i + 1
Next flt

ws is just my active Worksheet

I didn’t realise that i should make the array Variant, and not initialise it as a simple String array.

After that the criterias String looks like “Criteria1: =test1=test2=test3”, so just replace the “=” with “, ” or something like that and you’re done!

Axel Richter from a german office board was a big help in this issue 😉 (for the german readers: http://www.office-loesung.de/p/viewtopic.php?f=166&t=666472&p=2773974#p2773974)