VBA Autofilter / custom filter with contains variable

[Kinjal Doshi]

Hi,

It is regarding to one of the earlier posts.. the Code given there works fine.

[VBA] extending Autofilter to filter with multiple words, using wildcard

The following codes only manage to filter for 2 words. (i.e. txt, txt) When user inputs more than 2 words to filter (i.e. txt, txt, txt), an error just returns. Is there any workaround to filter more than 2 words, for a particular column? Thanks! Sub Test() iTxt = InputBox("containing ...

www.mrexcel.com

but is it possible to tweak the code as per my need?
In this code.. it does filter the words that I enter with comma separated value.. but it also filters if only one of the word is available in that cell.. I want it to filter only those cells where both the words are found in same cell

Now above is my list... If I filter with "APPLE, KIWI" or "KIWI, APPLE" then it will also filter Sr. No 4, 5 & 6 where only one of the strings are given. I want it to filter only if both the criteria's match in same cell

Please check if it is possible

 

[mart37]

something like this (not tested)

Sub Test()
    Dim r As Range, f As Range, cell As String, iTxt As Variant, arr() As Variant, n As Long, a As Variant
    
    Set r = Selection.CurrentRegion
    r.AutoFilter
    iTxt = InputBox("containing : t, t …", Default:=1)
    n = 0
    For Each a In Split(iTxt, ",")
        Set f = r.Find(a, LookIn:=xlValues, lookat:=xlPart)
        If Not f Is Nothing Then
            cell = f.Address
            Do
                ReDim Preserve arr(n)
                x = 0
                y = 0
                For Each b In Split(iTxt, ",")
                    If Worksheet.Match(b, f.Value, 0) > 0 Then x = x + 1
                    y = y + 1
                Next
                If x = y Then
                    arr(n) = f.Value
                    n = n + 1
                End If
                Set f = r.FindNext(f)
            Loop While Not f Is Nothing And f.Address <> cell
        End If
    Next
    r.AutoFilter Field:=1, Criteria1:=arr, Operator:=xlFilterValues
End Sub

 

[mart37]

when tested I found a mistake: If Worksheet.Match(b, f.Value, 0) > 0 Then x = x + 1 --> If InStr(f, b) > 0 Then x = x + 1

 

[Kinjal Doshi]

Hi Mart,

Thanks!
It's working perfectly.