VBA to Filter a spreadsheet with Criteria values i

Question

I have a code for filter criteria based on a array, but it filters exact match and not contains.

I want to filter all contains

I have the code this filters exact match

Criteria = Worksheets("Sheet1").Range("A1:A140") & Criteri & :*" - doesn't work

    Sub Filter969696()

Dim Criteria As Variant
Dim cri() As String

Criteria = Worksheets("Sheet1").Range("A1:A140")

ReDim Preserve cri(UBound(Criteria))

For I = LBound(Criteria) To UBound(Criteria)

    cri(I) = Criteria(I, 1)

Next

Worksheets("AP").Range("$A$1:$h$100").AutoFilter Field:=3, Criteria1:=cri, Operator:=xlFilterValues

End Sub

Filter all values contains the array provided

Answer 1

Here, Try this code:

I made it a quite big & Complex though, but it should work.

Too overcome the Excel restriction of 2 Contains, i added the exact macthes one by one in a new array and used it to apply the filter at once.

Sub Filter969696()

Dim Criteria As Variant
Dim cri() As String
Dim cri2() As String
Dim i As Integer
Dim j As Integer
Dim k As Integer

Criteria = Worksheets("Sheet1").Range("A1:A140")

ReDim Preserve cri(UBound(Criteria))
ReDim Preserve cri2(1)

For i = LBound(Criteria) To UBound(Criteria)

    cri(i) = "=*" & Criteria(i, 1) & "*"
    Worksheets("AP").Range("$A$1:$h$100").AutoFilter Field:=3, Criteria1:=cri(i), Operator:=xlFilterValues

    j = UBound(cri2)

    ReDim Preserve cri2(j + Worksheets("AP").Range("$A$1:$h$100").Columns(1).SpecialCells(xlCellTypeVisible).Count)

        For Each rw In Worksheets("AP").Range("$A$1:$h$100").SpecialCells(xlCellTypeVisible).Rows

                cri2(j + 1) = Cells(rw.Row, 1).Value
                j = j + 1

        Next

Next

Worksheets("AP").Range("$A$1:$h$100").AutoFilter Field:=3, Criteria1:=cri2, Operator:=xlFilterValues


End Sub