Macro to Select All Searched Items in Pivot Table

[shansakhi]

Hello Everybody,
I raised my request on excelforum but there was no response hence I am raising this request in Mr.Excel forum. Below is the link to my post on Excelforum for your reference...

Select Multiple item in Pivot Tables based on a Cell Value

I have below code which selects the item in pivot table based on a cell value and it's working as desired.
But when there are more than the same values in the filter, it does not select all.
e.g.
If the cell value is "LHR" then all items of filters containing "LHR" should get selected. It's like a Search option in the Pivot table, where it allows you to Select All Search Items.
In the below case, LHRBOM & KULLHR should get selected.

NONDIRECTIONAL OD (Filter Name)
LHRBOM
KULLHR
BOMMXP
ZRHCDG
CDGPAR

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xPTable As PivotTable
Dim xPfile As PivotField
Dim xStr As String
On Error Resume Next
If Intersect(Target, Range("B1:B3")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xPTable = Worksheets("Sheet9").PivotTables("PivotTable4")
Set xPfile = xPTable.PivotFields("NonDirectional")
xStr = Range("B2")
xPfile.ClearAllFilters
xPfile.CurrentPage = xStr
Application.ScreenUpdating = True
End Sub


Regards,
Shan

 

[DanteAmor]

If you are only going to put a value in cell B2 then use the following:

Private Sub Worksheet_Change2(ByVal Target As Range)
  Dim pTable As PivotTable, pField As PivotField, pItem As PivotItem
  Dim xStr As String, n As Long
  
  If Intersect(Target, Range("B2")) Is Nothing Then Exit Sub
  Application.ScreenUpdating = False
  
  Set pTable = Worksheets("Sheet9").PivotTables("PivotTable4")
  Set pField = pTable.PivotFields("NonDirectional")
  xStr = Range("B2")
  pField.ClearAllFilters
  n = 0
  For Each pItem In pField.PivotItems
    If Not LCase(pItem) Like "*" & LCase(xStr) & "*" Then
      n = n + 1
      If n < pField.PivotItems.Count Then
        pField.PivotItems(pItem.Value).Visible = False
      Else
        MsgBox "You are trying to hide all items"
        pField.ClearAllFilters
      End If
    End If
  Next
  Application.ScreenUpdating = True
End Sub

_______________________________________________________________
If you are going to put different values in cells B1, B2 and B3, That is, if in B2 you put "LHR" in B3 you can put "PAR" and the macro will show all the items that contain "LHR" or "PAR".
Then use the following:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim pTable As PivotTable, pField As PivotField, pItem As PivotItem
  Dim xStr As Range, xValue As Range, n As Long, exists As Boolean
  
  If Intersect(Target, Range("B1:B3")) Is Nothing Then Exit Sub
  Application.ScreenUpdating = False
  
  Set pTable = Worksheets("Sheet9").PivotTables("PivotTable4")
  Set pField = pTable.PivotFields("NonDirectional")
  Set xStr = Range("B1:B3")
  pField.ClearAllFilters
  n = 0
  For Each pItem In pField.PivotItems
    exists = False
    For Each xValue In xStr
      If xValue.Value <> "" Then
        If LCase(pItem) Like "*" & LCase(xValue) & "*" Then
          exists = True
          Exit For
        End If
      End If
    Next
    If exists = False Then
      n = n + 1
      If n < pField.PivotItems.Count Then
        pField.PivotItems(pItem.Value).Visible = False
      Else
        MsgBox "You are trying to hide all items"
        pField.ClearAllFilters
      End If
    End If
  Next
  Application.ScreenUpdating = True
End Sub