VBA to Filter Column Labels using Filter List

[SanjayGMusafir]

Hi Everyone
I need to filter my pivot table column label for Column "D1". I need this because everytime there is new item in D1, pivot table automatically clears all filters and starts showing all items.
Just to keep a record that which items I need to be seen, I created a list "PFilters" with column header "Name".
I searched internet and used following code to filter my pivot table. But what it does is that it counts number of entries in PFilters (e.g. 18) and hides First 18 Column "D1" labels and hangs...
I don't know where the challenge or error is. Please help me improve the VBA code. I'm quoting the VBA I'm using for your reference.
Thanks in advance.

'To Filter D1 Field as per the given Range - But ask before using filter
    Dim x As Integer
    x = MsgBox("Do you want to Filter Columns?", vbQuestion + vbYesNo + vbDefaultButton1, "")
    
    If x = vbYes Then
        Dim vArray As Variant, i As Integer, j As Integer, PF3 As PivotField
        
        Set PF3 = ActiveSheet.PivotTables("ExpAnalysis").PivotFields("D1")
        vArray = Range("PFilters[Name]")
        PF3.ClearAllFilters
    
        With PF3
            For i = 1 To PF3.PivotItems.Count
                j = 1
                Do While j <= UBound(vArray, 1) - LBound(vArray, 1) + 1
                    If PF3.PivotItems(i).Name = vArray(j, 1) Then
                    PF3.PivotItems(PF3.PivotItems(i).Name).Visible = True
                    Exit Do
                 Else
                    PF3.PivotItems(PF3.PivotItems(i).Name).Visible = False
                End If
              j = j + 1
              Loop
            Next i
        End With
        
    Else
    End If

 

[DanteAmor]

Try this:

Sub FilterPivotTableUsingFilterList()
  Dim pItm As PivotItem
  Dim FilterArr() As Variant, aItm As Variant
  Dim bExists As Boolean
  Dim n As Long
  
  Application.ScreenUpdating = False
  
  FilterArr = Range("PFilters[Name]").Value
  
  With ActiveSheet.PivotTables("ExpAnalysis").PivotFields("D1")
    .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
  
  Application.ScreenUpdating = True
End Sub

 

[SanjayGMusafir]

Try this:

Sub FilterPivotTableUsingFilterList()
  Dim pItm As PivotItem
  Dim FilterArr() As Variant, aItm As Variant
  Dim bExists As Boolean
  Dim n As Long
 
  Application.ScreenUpdating = False
 
  FilterArr = Range("PFilters[Name]").Value
 
  With ActiveSheet.PivotTables("ExpAnalysis").PivotFields("D1")
    .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
 
  Application.ScreenUpdating = True
End Sub

Thanks DanteAmor it worked like charm.