Pivotfields multiple filter

by

This code should do what you need. To learn more about filtering PivotTables quickly, check out my blogpost on the subject. 

Option Explicit

Sub FilterPivot()
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Dim i As Long
Dim vItem As Variant
Dim vCountries As Variant

Set pt = ActiveSheet.PivotTables("PivotTable1")
Set pf = pt.PivotFields("CountryName")

vCountries = Array("FRANCE", "BELGIUM", "LUXEMBOURG")

pt.ManualUpdate = True 'Stops PivotTable from refreshing after each PivotItem is changed

With pf

    'At least one item must remain visible in the PivotTable at all times, so make the first
    'item visible, and at the end of the routine, check if it actually  *should* be visible        
    .PivotItems(1).Visible = True

    'Hide any other items that aren't already hidden.
    'Note that it is far quicker to check the status than to change it.
    ' So only hide each item if it isn't already hidden
    For i = 2 To .PivotItems.Count
        If .PivotItems(i).Visible Then .PivotItems(i).Visible = False
    Next i

    'Make the PivotItems of interest visible
    On Error Resume Next 'In case one of the items isn't found
    For Each vItem In vCountries
        .PivotItems(vItem).Visible = True
    Next vItem
    On Error GoTo 0

    'Hide the first PivotItem, unless it is one of the countries of interest
    On Error Resume Next
    If InStr(UCase(Join(vCountries, "|")), UCase(.PivotItems(1))) = 0 Then .PivotItems(1).Visible = False
    If Err.Number <> 0 Then
        .ClearAllFilters
        MsgBox Title:="No Items Found", Prompt:="None of the desired items was found in the Pivot, so I have cleared the filter"
    End If
    On Error GoTo 0

End With

pt.ManualUpdate = False

End Sub

More Related Contents:

  1. SumIf using Excel VBA
  2. Test or check if sheet exists
  3. Copy from one workbook and paste into another
  4. How to copy Outlook mail message into excel using VBA or Macros
  5. For Loop not fully cycling in excel VBA [duplicate]
  6. Unique Random Numbers using VBA
  7. Populate unique values into a VBA array from Excel
  8. Excel VBA App stops spontaneously with message “Code execution has been halted”
  9. How to remove all non alphanumeric characters from a string except period and space in excel?
  10. Closing Excel Application using VBA
  11. How to clear memory to prevent “out of memory error” in excel vba?
  12. Delete Row based on Search Key VBA
  13. How to add a button programmatically in VBA next to some sheet cell data?
  14. What are the benefits of setting objects to “Nothing”
  15. How can I kill task manager processes through VBA code?
  16. VBA: Usage of parentheses for a method
  17. Fully reference a worksheet by codename
  18. OnTime for less than 1 second without becoming Unresponsive
  19. VBA equivalent to Excel’s mod function
  20. Copy a selected range to another worksheet
  21. Excel macro – paste only non empty cells from one sheet to another
  22. The MacScript function is not working well in Office for Mac 2016! Any ideas?
  23. Pointers needed for speeding up nested loop macro in VBA
  24. ‘1004’: “The sort reference is not valid.”
  25. Select entire column in table using Excel VBA
  26. Create hyperlink to another sheet
  27. Reducing WithEvent declarations and subs with VBA and ActiveX
  28. Convert Early Binding VBA to Late Binding VBA : Excel to Outlook Contacts
  29. Function Overloading and UDF in Excel VBA
  30. VBA: Modify chart data range

Leave a Comment