VBA filter pivot table with wildcard array from named range

Question

I'm currently struggling to get a dynamic filter to work.

Initial situation: Pivot Table where i need to filter for multiple different words. It is always build like this:

7.06610.14.0 EDR-E -> i need to filter for some specific words

7.03083.11.0 EAM

7.05569.18.0 REGELKLAPPE

7.09451.00.0 EAM-S

...

I created a named range for the words i need to filter.

I'm able to get all of them in an array with a wildcard character, but the system just won't filter.

Here's the code to fill my array:

Dim myArray() As Variant
Dim myNr As Long

Bereich = Range("_Bereich") 'Named range
myArray = Range("_" & Bereich & "Filter") 
For myNr = LBound(myArray, 1) To UBound(myArray, 1)
    myArray(myNr, 1) = "*" & myArray(myNr, 1)
Next myNr

That's the output: Array input

But here all my tries failed...

i just can't get these to be filtered on my pivot table.

These are just a few of the options i tried:

Sub test2()
Dim myArray() As Variant
Dim myNr As Long
Dim pvItem As PivotItem

Bereich = Range("_Bereich")

myArray = Range("_" & Bereich & "Filter")
For myNr = LBound(myArray, 1) To UBound(myArray, 1)
    myArray(myNr, 1) = "*" & myArray(myNr, 1)
    Debug.Print myArray(myNr, 1)
Next myNr

Worksheets(Bereich).Select
With ActiveSheet.PivotTables("tblMenge" & Bereich).PivotFields("Material")
    .EnableMultiplePageItems = True
    .ClearAllFilters
    For Each pvItem In .PivotItems
        If Not IsError(Application.Match(pvItem.Caption, myArray, 0)) Then
            pvItem.Visible = True
        Else
            pvItem.Visible = False
        End If
    Next pvItem
End With

End Sub

Sub test3()
Dim myArray() As Variant
Dim myNr As Long
Dim pvItem

Bereich = Range("_Bereich")
Worksheets(Bereich).Select
With ActiveSheet.PivotTables("tblMenge" & Bereich).PivotFields("Material")
    .ClearAllFilters
    .EnableMultiplePageItems = True
    For Each pvItem In .PivotItems("All")
        pvItem.Visible = False
    Next
    
    myArray = Range("_" & Bereich & "Filter") 
    
    For myNr = LBound(myArray, 1) To UBound(myArray, 1)
        .PivotItems(myArray(myNr, 1)).Visible = True
    Next myNr
End With

End Sub

Sub test5()
Bereich = Range("_Bereich")

Dim myArray As Variant
myArray = Range("_" & Bereich & "Filter")

Dim pvFld As PivotField, found As Boolean, n As Long, i As Long, j As Long
Set pvFld = ActiveSheet.PivotTables("tblMenge" & Bereich).PivotFields("Material")

With pvFld
    .ClearAllFilters
    For i = 1 To .PivotItems.Count
        found = False
        For j = LBound(myArray, 1) To UBound(myArray, 1)
        myArray(j, 1) = "*" & myArray(j, 1)
            If .PivotItems(i).Name = myArray(j, 1) Then
                found = True
                n = n + 1
                Exit For
            End If
        Next j
        If i = .PivotItems.Count And n = 0 Then
            .ClearAllFilters
            MsgBox "Unable to filter by the list of pivot items", _
                vbExclamation, "No items found"
        ElseIf Not found Then
            .PivotItems(i).Visible = False
        End If
    Next i
    .EnableMultiplePageItems = True
End With

End Sub

Answer 1

• PivotItemName in .PivotItems(...) muse be exactly same as the item. It doesn't support wildcards.

• Like is an operator to compare two strings. It supports wildcards.

Microsoft documentation:

Like operator

Sub test3()
    Dim myArray() As Variant
    Dim myNr As Long
    Dim pvItem As PivotItem
    Worksheets(Bereich).Select
    Bereich = Range("_Bereich")
    myArray = Range("_" & Bereich & "Filter").Value
    For myNr = LBound(myArray, 1) To UBound(myArray, 1)
        myArray(myNr, 1) = "*" & myArray(myNr, 1)
    Next myNr
    With ActiveSheet.PivotTables("tblMenge" & Bereich).PivotFields("Material")
        .ClearAllFilters
        .EnableMultiplePageItems = True
        For Each pvItem In .PivotItems
            pvItem.Visible = False
            For myNr = LBound(myArray, 1) To UBound(myArray, 1)
                If pvItem.Name Like myArray(myNr, 1) Then
                    pvItem.Visible = True
                    Exit For
                End If
            Next myNr
        Next
    End With
End Sub