Macro to Filter Pivot Table

[howard]

I have a Pivot Table called Pivottable2 on sheet "Pivot table"


I have tried to write code to automate filtering the "Product Name" which is in rows to containing the following:

1) All item starting with "EJQZ"
2) Items that have the following text :
FACTORY MAINTENANCE PLAN ,"MECH-PROTECTION, "ZRTYP TRE SERVICE PLAN

 Sub FilterPivotTable()
    Dim ws As Worksheet
    Dim pt As PivotTable
    Dim pf As PivotField
    Dim pi As PivotItem
    Dim itemName As String
    Dim keepVisibleItems As Collection
    Dim additionalItems As Variant
    Dim i As Long

    ' Initialize the collection to store the items to keep visible
    Set keepVisibleItems = New Collection

    ' List of additional items to keep visible
    additionalItems = Array("FACTORY MAINTENANCE PLAN", _
                            "MECH-PROTECTION", _
                            "ZRTYP TRE SERVICE PLAN")

    ' Specify the sheet and pivot table
    Set ws = ThisWorkbook.Sheets("Pivot Table") ' Change this to your sheet name
    Set pt = ws.PivotTables("PivotTable2") ' Change this to your pivot table name
    Set pf = pt.PivotFields("Product Name") ' Change this to your pivot field name

    ' Loop through each pivot item and store those that start with "ECMG"
    For Each pi In pf.PivotItems
        itemName = pi.Name
        If Left(itemName, 4) = "EJQZ" Then
            keepVisibleItems.Add pi.Name
        End If
    Next pi

    ' Add the additional items to the collection
    For i = LBound(additionalItems) To UBound(additionalItems)
        keepVisibleItems.Add additionalItems(i)
    Next i

    ' Apply the filter to show only the items in the collection
    pf.ClearAllFilters
    For Each pi In pf.PivotItems
        If IsInCollection(keepVisibleItems, pi.Name) Then
            pi.Visible = True
        Else
            pi.Visible = False
        End If
    Next pi
End Sub

Function IsInCollection(col As Collection, item As Variant) As Boolean
    Dim var As Variant
    On Error Resume Next
    var = col(item)
    If Err.Number = 0 Then
        IsInCollection = True
    Else
        IsInCollection = False
    End If
    On Error GoTo 0
End Function

It would be appreciated if someone could amend my code

 

[DanteAmor]

With the following option you check if there is data that will remain visible in the pivot table, if there is no data, then it sends you a msgbox.

Sub FilterPivotTable()
  Dim adItems As Variant, pItm As Variant, aItm As Variant
  Dim pt      As PivotTable
  Dim pf      As PivotField
  Dim bExists As Boolean
  Dim n       As Long
  
  ' List of additional items to keep visible
  adItems = Array("FACTORY MAINTENANCE PLAN", _
                  "MECH-PROTECTION", _
                  "ZRTYP TRE SERVICE PLAN")
  
  Set pt = ThisWorkbook.Sheets("Pivot Table").PivotTables("PivotTable2")
  Set pf = pt.PivotFields("Product Name")
  pf.ClearAllFilters
  
  For Each pItm In pf.PivotItems
    bExists = False
    For Each aItm In adItems
      If aItm = pItm Then
        bExists = True
        Exit For
      End If
    Next

    If bExists = False Then
      If Left(pItm.Value, 4) <> "EJQZ" Then
        n = n + 1
        If n < pf.PivotItems.Count Then
          pItm.Visible = False
        Else
          pf.ClearAllFilters
          MsgBox "None of the values exist"
        End If
      End If
    End If
  Next
End Sub

----- --
Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
----- --

 

[howard]

Hi Dante

Many Thanks for all the effort. Your Code works 100%