AutoFilter with multiple criteria using dictionary

Question

I am trying to filter column with multiple criteria using an array.
I think it can be done using a Dictionary like the accepted answer of this question Link.
I adapted the code a little , But I got (Type Mismatch error) at this line:

If Application.Match(filter_Criteria(i), subStrings, 0) Then

Note: If there is another answer (without using a helper column) is highly welcomed.

Sub AutoFilter_With_Multiple_Criteria()

    Const filter_Column As Long = 2
    Const filter_Delimiter As String = " "
    
    Dim filter_Criteria() As Variant
    filter_Criteria = Array("Cathodic Protection", "C.P", "Riser")
    
    Dim ws As Worksheet:    Set ws = ActiveSheet
    
    Dim rg As Range
    Set rg = ws.UsedRange.Resize(ws.UsedRange.Rows.count - 1).Offset(1) 'the source range (UsedRange except the first Row)

    Dim rCount As Long, arr() As Variant
    rCount = rg.Rows.count - 1
    arr = rg.Columns(filter_Column).Resize(rCount).Offset(1).value      'Write the values from criteria column to an array.
        
    Dim dict As New Dictionary                                    'Write the matching strings to the keys (a 1D array) of a dictionary.
    
    Dim subStrings() As String, r As Long, i As Long, rStr As String
    
    For r = 1 To rCount                                           'Loop through the elements of the array.
        rStr = arr(r, 1)                                          'Convert the current value to a string and store it in a variable.
        If Len(rStr) > 0 Then                                     'is not blank
           subStrings = Split(rStr, filter_Delimiter)                 'Split the string into an array.
            For i = 0 To UBound(filter_Criteria)
              If Application.Match(filter_Criteria(i), subStrings, 0) Then
                If Not dict.Exists(rStr) Then
                    dict(rStr) = Empty
                End If
              End If
            Next i
        End If
    Next r
    
    If dict.count > 0 Then
        rg.AutoFilter Field:=filter_Column, Criteria1:=dict.Keys, Operator:=xlFilterValues   'use the keys of the dictionary (a 1D array) as a Criteria
    End If
    
End Sub
 

Answer 1

If you need to filter by cells containing any of the criteria array element, please try the next adapted code. It assumes that you need to filter on the first column (A:A):

Sub AutoFilter_With_Multiple_Criteria()

    Const filter_Column As Long = 1 'column A:A
    
    Dim filter_Criteria() As Variant: filter_Criteria = Array("*Cathodic Protection*", "*C.P*", "*Riser*") 'changed array to avoid exact matches!
    
    Dim ws As Worksheet:    Set ws = ActiveSheet
    
    If ws.AutoFilterMode Then ws.AutoFilterMode = False
    
    Dim rg As Range
    Set rg = ws.UsedRange.Resize(ws.UsedRange.rows.count - 1).Offset(1) 'the source range (UsedRange except the first Row)

    Dim rCount As Long, arr() As Variant, El
    rCount = rg.rows.count - 1
    arr = rg.Columns(filter_Column).Resize(rCount).Offset(1).Value     'Write the values from criteria column to an array.
        
    Dim dict As New scripting.Dictionary                               'Write the matching strings to the keys (a 1D array) of a dictionary.
    
    Dim r As Long
    
    For r = 1 To rCount                                               'Loop through the elements of the array.
        If Len(arr(r, 1)) > 0 Then                                    'is not blank
            For Each El In filter_Criteria
                If arr(r, 1) Like El Then dict(arr(r, 1)) = vbNullString: Exit For
            Next El
        End If
    Next r
    
    If dict.count > 0 Then
        rg.AutoFilter field:=filter_Column, Criteria1:=dict.keys, Operator:=xlFilterValues   'use the keys of the dictionary (a 1D array) as a Criteria
    End If
    
End Sub

Edited:

If you need the opposite (to filter what does not match any array element, you should change the dictionary loading iteration in the next way:

Dim boolFound as Boolean

    For r = 1 To rCount                                           
        If Len(arr(r, 1)) > 0 Then                               
            boolFound = False
            For Each El In filter_Criteria
                If arr(r, 1) Like El Then boolFound = True: Exit For
           Next El
           If Not boolFound Then dict(CStr(arr(r, 1))) = vbNullString 'CStr used in case of numeric values, which be converted to string in order to be taken in consideration...
        End If
    Next r
    Debug.Print Join(dict.keys, "|"): Stop 'just to see the new built array...