Select Multiple Items in Pivot Table Filter Based on Array

[rilzniak]

I'm so close (but so far) on a solution, I believe. I have a worksheet titled "Users" with an Excel table named "KDR" which has three entries - names that should be filtered. The header of that Excel Table is also the name of the Excel Table - "KDR". On another sheet, I created a dashboard with 13 Pivot Tables/Charts and I'd like to filter them all based on a cell on a third worksheet. I've pieced together some code but I can't seem to get un-stuck from my logic and I'm sure it's something simple. Here's what I've got:

Dim PT As PivotTable
Dim PVTF As String
Dim VAL As String
Dim i As Integer
Dim FilterArr() As Variant

PVTF = "Rep"
VAL = Worksheets(shtLogin).Range("c4").Value

FilterArr = Worksheets(shtUsers).ListObjects(VAL).DataBodyRange.Value

    For Each PT In Worksheets("RD").PivotTables
        With PT.PivotFields(PVTF)
            .ClearManualFilter
            .EnableMultiplePageItems = True
                For i = 1 To UBound(FilterArr)
                    .PivotItems(FilterArr(i, 1)).Visible = False
                Next i
        End With
    Next
   
End Sub

I know that "= False" is not the right logic because it excludes the items from the 'FilterArr' and when I use 'True' it will do nothing since I'm not excluding entries. I should probably be using both with an 'If - Else' statement but I'm not sure how to get it to that finish line (match entries in the array, perhaps). Suggestions?

 

[DanteAmor]

Try this:

Sub macro()
  Dim PT As PivotTable, pItm As PivotItem
  Dim PVTF As String, xVAL As String
  Dim FilterArr() As Variant, aItm As Variant
  Dim bExists As Boolean
  Dim n As Long
  
  Application.ScreenUpdating = False
  
  PVTF = "Rep"
  xVAL = Sheets(shtLogin).Range("C4").Value
  
  FilterArr = Sheets(shtUsers).ListObjects(xVAL).DataBodyRange.Value
  
  For Each PT In Sheets("RD").PivotTables
    With PT.PivotFields(PVTF)
      .ClearAllFilters
      n = 0
      For Each pItm In .PivotItems
        bExists = False
        For Each aItm In FilterArr
          If LCase(aItm) = LCase(pItm.Value) Then
            bExists = True
            Exit For
          End If
        Next
        If bExists = False Then
          n = n + 1
          If n < .PivotItems.Count Then
            pItm.Visible = False
          Else
            .ClearAllFilters
          End If
        End If
      Next
    End With
  Next
End Sub

 

[rilzniak]

Try this:

Sub macro()
  Dim PT As PivotTable, pItm As PivotItem
  Dim PVTF As String, xVAL As String
  Dim FilterArr() As Variant, aItm As Variant
  Dim bExists As Boolean
  Dim n As Long
 
  Application.ScreenUpdating = False
 
  PVTF = "Rep"
  xVAL = Sheets(shtLogin).Range("C4").Value
 
  FilterArr = Sheets(shtUsers).ListObjects(xVAL).DataBodyRange.Value
 
  For Each PT In Sheets("RD").PivotTables
    With PT.PivotFields(PVTF)
      .ClearAllFilters
      n = 0
      For Each pItm In .PivotItems
        bExists = False
        For Each aItm In FilterArr
          If LCase(aItm) = LCase(pItm.Value) Then
            bExists = True
            Exit For
          End If
        Next
        If bExists = False Then
          n = n + 1
          If n < .PivotItems.Count Then
            pItm.Visible = False
          Else
            .ClearAllFilters
          End If
        End If
      Next
    End With
  Next
End Sub

Works perfectly! I wouldn't have gotten there without your help. Thank you (again!), Dante.

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.