Pivot Table- "Master" Report Filter

[Robz999]

Hi,

On Sheet 1 of my workbook, I have several different Pivot Tables in the worksheet.

Each pivot table pulls unique data from different tables in Sheet 2,3,4 etc.

However, there is one column, "Prospect" that has similar data in each table and currently exists as the Report Filter on each of my Pivot Tables in worksheet 1.

Whenever I change one Report Filter, I would change them all.

For example, if I wanted to see the details of "Prospect A", I would change each pivot table's report filters to Prospect A. If I wanted to see details of "Prospect B", I would then need to change each report filter on each individual pivot table to "Prospect B"

What I am wondering is if there is a way to set it so that when I change to the filter on one of my pivot tables, it changes the filter on all other pivot tables as well?

Thanks in advance for the help

 

[Jerry Sullivan]

Hi Robz999,

You can try the example below.

There are four parts: A worksheet event function that will trigger the code whenever you change your PivotTable,
and three supporting functions.


To use the code (always test new code on a copy of your workbook):
1. Right Click on the Tab of your Sheet that has the PivotTables
2. Select View Code
3. Copy and Paste the Sub Worksheet_Change Code below into the Sheet Code module
4. Edit the Names in Blue Font to match your Master PivotTable and Field Name

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim sMaster As String, sField As String
        
    sMaster = "PivotTable1"
    sField = "Prospect"
    
    With ActiveSheet
        If Intersect(Target, .PivotTables(sMaster) _
            .TableRange2) Is Nothing Then Exit Sub
        
        On Error GoTo CleanUp
        Application.EnableEvents = False
    
        Call Synch_All_PT_Filters_BasedOn( _
            PT:=.PivotTables(sMaster), sField:=sField)
    End With
CleanUp:
    Application.EnableEvents = True
End Sub

Then insert 3 functions into a Standard Code Module
5. Press the keys ALT + I to activate the Insert menu
6. Press M to insert a Standard Module
7. Copy and Paste the 3 functions below into the Standard module

Public Function Synch_All_PT_Filters_BasedOn(PT As PivotTable, _
        sField As String)
    Dim PT2 As PivotTable
    Dim vItems As Variant
    
    '---Stores the visible items in an array
    vItems = Store_PT_FilterItems(PT, sField)
    
    '---make array of visible items in PT
    For Each PT2 In ActiveSheet.PivotTables
        If PT2.name <> PT.name Then
        '---Applies same filter items to each PivotTable
            Call Filter_PivotField( _
                pvtField:=PT2.PivotFields(sField), _
                    vItems:=vItems)
        End If
    Next PT2
End Function

Private Function Store_PT_FilterItems(PT As PivotTable, _
        sField As String) As Variant
'---Stores visible items in PivotField sField in an array
    Dim sVisibleItems() As String
    Dim pviItem As PivotItem
    Dim i As Long
    
    With PT.PivotFields(sField)
        If .Orientation = xlPageField And _
            .EnableMultiplePageItems = False Then
                ReDim sVisibleItems(1)
                sVisibleItems(0) = .CurrentPage
        Else
            For Each pviItem In .PivotItems
                If pviItem.Visible Then
                    i = i + 1
                    ReDim Preserve sVisibleItems(i)
                    sVisibleItems(i - 1) = pviItem
                End If
            Next
        End If
    End With
    Store_PT_FilterItems = sVisibleItems
End Function

Private Function Filter_PivotField(pvtField As PivotField, _
        vItems As Variant)
'---Filters the PivotField to make stored vItems Visible
    Dim sItem As String, bTemp As Boolean, i As Long
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    If Not (IsArray(vItems)) Then
         vItems = Array(vItems)
    End If
 
    With pvtField
        .Parent.ManualUpdate = True
        If .Orientation = xlPageField Then .EnableMultiplePageItems = True
        If vItems(0) = "(All)" Then
            For i = 1 To .PivotItems.Count
                If Not .PivotItems(i).Visible Then _
                    .PivotItems(i).Visible = True
            Next i
        Else
            For i = LBound(vItems) To UBound(vItems)
                bTemp = Not (IsError(.PivotItems(vItems(i)).Visible))
                If bTemp Then
                    sItem = .PivotItems(vItems(i))
                    Exit For
                End If
            Next i
            If sItem = "" Then
                MsgBox "None of filter list items found."
                GoTo CleanUp
            End If
            .PivotItems(sItem).Visible = True
            For i = 1 To .PivotItems.Count
                If IsError(Application.Match(.PivotItems(i), _
                    vItems, 0)) = .PivotItems(i).Visible Then
                    .PivotItems(i).Visible = Not (.PivotItems(i).Visible)
                End If
            Next i
        End If
    End With
    
CleanUp:
    pvtField.Parent.ManualUpdate = False
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Function

Please let me know if you need any help getting this setup.

 

[thetisch]

Hello,
I arrive years later but thanks for this very useful code !

But I have some trouble to adapt it to my needs :
--- I have a "PivotSheet" with 5 pivot tables linked to a dataset located in "TurnoverSheet" (the master PV is named "PV1") and 1 pivot linked to another dataset located in "FeesSheet"
All the pivot tables share a "BUSINESSLINE" field
--- I have a "DashboardSheet" (which does not use pivot tables) on which I placed a slicer using conencted to the "PV1"

I would like that this slider filter the 6 pivot tables with the BUSINESSLINE chosen on the slider.

I copy pasted the code you sent and it is working well when I am in the "PivotSheet" (i.e. changing the "PV1" pivot table updates well all the other 5 pivot tables) but using the slider on the "Dashboardfield" will only update the "PV1" but not the others...

Thanks in advance for your answer !

Rudy.

 

[Jerry Sullivan]

Hi Rudy,

If I'm understanding your setup, try changing this part of the code to reference PivotSheet instead of the ActiveSheet:

Public Function Synch_All_PT_Filters_BasedOn(PT As PivotTable, _
        sField As String)
    Dim PT2 As PivotTable
    Dim vItems As Variant
    
    '---Stores the visible items in an array
    vItems = Store_PT_FilterItems(PT, sField)
    
    '---make array of visible items in PT
    For Each PT2 In [B]Sheets("PivotSheet")[/B].PivotTables

I'm not sure what you mean by the term "slider". Are you referring to a PivotTable Slicer or something else?

 

[thetisch]

Thanks Jerry, it seems to be ok now !
I was indeed making reference to a slicer and not a slider

Best regards,

Rudy.

Hi Rudy,

If I'm understanding your setup, try changing this part of the code to reference PivotSheet instead of the ActiveSheet:

Public Function Synch_All_PT_Filters_BasedOn(PT As PivotTable, _
        sField As String)
    Dim PT2 As PivotTable
    Dim vItems As Variant
    
    '---Stores the visible items in an array
    vItems = Store_PT_FilterItems(PT, sField)
    
    '---make array of visible items in PT
    For Each PT2 In [B]Sheets("PivotSheet")[/B].PivotTables

I'm not sure what you mean by the term "slider". Are you referring to a PivotTable Slicer or something else?

 

[Jakub_S]

Hello Jerry,

Is it possible to modify your code for multiple filter fields in pivot tables? I got to declaring new s2Field everywhere I've found sField, but got stuck there.

Thank you in advance for your help
Jakub

 

[Jakub_S]

Hello Jerry,

Is it possible to modify your code for multiple filter fields in pivot tables? I got to declaring new s2Field everywhere I've found sField, but got stuck there.

Thank you in advance for your help
Jakub

Hello again,

So far I've came up with this alteration:
I've added sField2, vItems2, pvtField2 and 2 new functions - Store_PT_FilterItems2 and Filter_PivotField2 (see the code below).
Not surprisingly it doesn't work at all, so if someone could help me I would be very thankful. It would probably be better idea to alter Jerry's code, as I suspect mine to be totally unusable.

Thank you
Jakub

My Sub Worksheet_Change Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim sMaster As String, sField1 As String, sField2 As String
        
    sMaster = "PivotTable1"
    sField1 = "buy_domain"
    sField2 = "global_supplier"
    
    With Sheets("general pivot")
        If Intersect(Target, .PivotTables(sMaster) _
            .TableRange2) Is Nothing Then Exit Sub
        
        On Error GoTo CleanUp
        Application.EnableEvents = False
    
        Call Synch_All_PT_Filters_BasedOn( _
            PT:=.PivotTables(sMaster), sField1:=sField1, sField2:=sField2)
    End With
CleanUp:
    Application.EnableEvents = True
End Sub

My 5 functions in standart module:

Public Function Synch_All_PT_Filters_BasedOn(PT As PivotTable, _
        sField1 As String, sField2 As String)
    Dim PT2 As PivotTable
    Dim vItems1 As Variant
    Dim vItems2 As Variant
    
    '---Stores the visible items in an array
    vItems1 = Store_PT_FilterItems(PT, sField1)
    vItems2 = Store_PT_FilterItems2(PT, sField2)
    
    '---make array of visible items in PT
    For Each PT2 In Sheets("general pivot").PivotTables
        If PT2.Name <> PT.Name Then
        '---Applies same filter items to each PivotTable
            Call Filter_PivotField( _
                pvtField:=PT2.PivotFields(sField1), _
                    vItems1:=vItems1)
            Call Filter_PivotField2( _
                pvtField2:=PT2.PivotFields(sField2), _
                    vItems2:=vItems2)
        End If
    Next PT2
End Function

Private Function Store_PT_FilterItems(PT As PivotTable, _
        sField1 As String) As Variant
'---Stores visible items in PivotField sField in an array
    Dim sVisibleItems() As String
    Dim pviItem As PivotItem
    Dim i As Long
    
    With PT.PivotFields(sField1)
        If .Orientation = xlPageField And _
            .EnableMultiplePageItems = False Then
                ReDim sVisibleItems(1)
                sVisibleItems(0) = .CurrentPage
        Else
            For Each pviItem In .PivotItems
                If pviItem.Visible Then
                    i = i + 1
                    ReDim Preserve sVisibleItems(i)
                    sVisibleItems(i - 1) = pviItem
                End If
            Next
        End If
    End With
    Store_PT_FilterItems = sVisibleItems
End Function

Private Function Store_PT_FilterItems2(PT As PivotTable, _
        sField2 As String) As Variant
'---Stores visible items in PivotField sField in an array
    Dim sVisibleItems() As String
    Dim pviItem As PivotItem
    Dim i As Long
    
    With PT.PivotFields(sField2)
        If .Orientation = xlPageField And _
            .EnableMultiplePageItems = False Then
                ReDim sVisibleItems(1)
                sVisibleItems(0) = .CurrentPage
        Else
            For Each pviItem In .PivotItems
                If pviItem.Visible Then
                    i = i + 1
                    ReDim Preserve sVisibleItems(i)
                    sVisibleItems(i - 1) = pviItem
                End If
            Next
        End If
    End With
    Store_PT_FilterItems2 = sVisibleItems
End Function

Private Function Filter_PivotField(pvtField As PivotField, _
        vItems1 As Variant)
'---Filters the PivotField to make stored vItems1 Visible
    Dim sItem As String, bTemp As Boolean, i As Long
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    If Not (IsArray(vItems1)) Then
         vItems1 = Array(vItems)
    End If
 
    With pvtField
        .Parent.ManualUpdate = True
        If .Orientation = xlPageField Then .EnableMultiplePageItems = True
        If vItems1(0) = "(All)" Then
            For i = 1 To .PivotItems.Count
                If Not .PivotItems(i).Visible Then _
                    .PivotItems(i).Visible = True
            Next i
        Else
            For i = LBound(vItems1) To UBound(vItems1)
                bTemp = Not (IsError(.PivotItems(vItems1(i)).Visible))
                If bTemp Then
                    sItem = .PivotItems(vItems1(i))
                    Exit For
                End If
            Next i
            If sItem = "" Then
                MsgBox "None of filter list items found."
                GoTo CleanUp
            End If
            .PivotItems(sItem).Visible = True
            For i = 1 To .PivotItems.Count
                If IsError(Application.Match(.PivotItems(i), _
                    vItems1, 0)) = .PivotItems(i).Visible Then
                    .PivotItems(i).Visible = Not (.PivotItems(i).Visible)
                End If
            Next i
        End If
    End With
        
CleanUp:
    pvtField.Parent.ManualUpdate = False
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Function

Private Function Filter_PivotField2(pvtField2 As PivotField, _
        vItems2 As Variant)
'---Filters the PivotField to make stored vItems Visible
    Dim sItem As String, bTemp As Boolean, i As Long
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    If Not (IsArray(vItems2)) Then
         vItems2 = Array(vItems2)
    End If
     
     With pvtField2
        .Parent.ManualUpdate = True
        If .Orientation = xlPageField Then .EnableMultiplePageItems = True
        If vItems2(0) = "(All)" Then
            For i = 1 To .PivotItems.Count
                If Not .PivotItems(i).Visible Then _
                    .PivotItems(i).Visible = True
            Next i
        Else
            For i = LBound(vItems2) To UBound(vItems2)
                bTemp = Not (IsError(.PivotItems(vItems2(i)).Visible))
                If bTemp Then
                    sItem = .PivotItems(vItems2(i))
                    Exit For
                End If
            Next i
            If sItem = "" Then
                MsgBox "None of filter list items found."
                GoTo CleanUp
            End If
            .PivotItems(sItem).Visible = True
            For i = 1 To .PivotItems.Count
                If IsError(Application.Match(.PivotItems(i), _
                    vItems2, 0)) = .PivotItems(i).Visible Then
                    .PivotItems(i).Visible = Not (.PivotItems(i).Visible)
                End If
            Next i
        End If
    End With
    
CleanUp:
    pvtField2.Parent.ManualUpdate = False
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Function

 

[Jerry Sullivan]

Hi Jakub, Sorry for my delay in getting back to you. I thought I had a thread in which I provided some code to do what you describe, but I struck out trying to find it. (finding too many threads on filtering pivots, but not the right one).

I'm wrapping up for the night here, but I'll post a suggestion tomorrow.

 

[Jerry Sullivan]

Hi Jakub, I ended up rewriting most of this code. Below is some code based on the example that you gave. Replace all the previous code with these procedures.

In the Worksheet Code of the worksheet that holds the MasterPivotTable and all PivotTables to sync.

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
 Dim sField1 As String, sField2 As String
 Dim sErrMsg As String
 Dim vFieldList As Variant
 
 Const sMASTER As String = "PivotTable1"
 
 If Target.Name <> sMASTER Then GoTo ExitProc

 On Error GoTo ErrProc
 Application.EnableCancelKey = xlErrorHandler
 Application.EnableEvents = False
        
 '--edit to list fields to be synced.
 vFieldList = Array("buy_domain", "global_supplier")
  
 '--only call sync if action triggering event was filter.
 '  will attempt to sync all PivotTables on this sheet
 If bLastActionFilteredPivot() Then
    Call SyncPivotFilterItemsBasedOn( _
       pvtMaster:=Target, vFieldList:=vFieldList)
 End If
 
ExitProc:
 On Error Resume Next
 Application.EnableEvents = True
 If Len(sErrMsg) Then MsgBox sErrMsg
 Exit Sub

ErrProc:
 sErrMsg = Err.Number & ": " & Err.Description
 Resume ExitProc
End Sub

Paste into a Standard Code Module (like Module1)

'--in a Standard Code Module

'--if set to True, will display msgbox warning if
'    no pivotitems matching criteria are found
'--this should only occur if pivottables on sheet with
'    master don't share the same pivot cache.
Const mbDISPLAY_WARNINGS As Boolean = False


Sub SyncPivotFilterItemsBasedOn(pvtMaster As PivotTable, _
   vFieldList As Variant)
   
 Dim dctFilterData As Object
 Dim lFieldCount As Long, lNdx As Long
 Dim sField As String
 Dim vVisibleItems As Variant, vFieldKey As Variant
 Dim pvt As PivotTable
 
 '--use dictionary to store each field name as a key with an array of
 '     visible items stored as value.
 Set dctFilterData = CreateObject("Scripting.Dictionary")
 dctFilterData.CompareMode = 1 'TextCompare
 
 For lNdx = LBound(vFieldList) To UBound(vFieldList)
   sField = vFieldList(lNdx)
   '--get visbib
   vVisibleItems = vGetVisibleItemList(pvt:=pvtMaster, sField:=sField)
   
   '-create key to store field name and visible items
   dctFilterData.Add vFieldList(lNdx), vVisibleItems
 Next lNdx
    
 '---filter other pivots to has same items visible as master
 For Each pvt In ActiveSheet.PivotTables
   If pvt.Name <> pvtMaster.Name Then
      For Each vFieldKey In dctFilterData
         vVisibleItems = dctFilterData.Item(vFieldKey)
         '---Applies same filter items
         Call FilterPivotField(pvf:=pvt.PivotFields(vFieldKey), _
            vVisibleItems:=vVisibleItems)
      Next vFieldKey
   End If
 Next pvt
End Sub

Public Function bLastActionFilteredPivot() As Boolean
 '--returns True if last acction was a slicer or pivot filter
 
 Dim bReturn As Boolean
 Dim sLastUndoStackItem As String
 
'--handle scenario of empty undo stack
 On Error Resume Next
 sLastUndoStackItem = Application.CommandBars("Standard").FindControl(ID:=128).List(1)
 On Error GoTo 0
         
 '--validate event was triggered by slicer or filter, not other pivot operation
 Select Case sLastUndoStackItem
   Case "Slicer Operation", "Filter"
      bReturn = True
   Case Else
   '--no action
 End Select
 
 bLastActionFilteredPivot = bReturn
End Function

Private Function dctReadPivotItemsToDictionary( _
   ByVal pvf As PivotField) As Object
   
'--returns a dictionary consisting of keys for each pivotitem caption
'     in the passed pivotfield.
'  blank pivot items are stored as the key "(blank)"
'  missing pivotitems (retained by filters) are not stored in dictionary

 Dim bCheckForMissingItems As Boolean
 Dim dctPviCaptions As Object
 Dim lItem As Long
 Dim sItem As String
  
 Set dctPviCaptions = CreateObject("Scripting.Dictionary")
 dctPviCaptions.CompareMode = 1 'TextCompare
 
 '--check if missing items might be in cache
 bCheckForMissingItems = pvf.Parent.PivotCache _
   .MissingItemsLimit <> xlMissingItemsNone
 
 For lItem = 1 To pvf.PivotItems.Count
   With pvf.PivotItems(lItem)
      Select Case True
         Case bCheckForMissingItems = False, .RecordCount
            sItem = dctPviCaptions.Item(.Caption)
         Case .Caption = "(blank)"
            sItem = dctPviCaptions.Item("(blank)")
         Case Else
            '--don't add to dictionary
      End Select
   End With
 Next lItem
 
 Set dctReadPivotItemsToDictionary = dctPviCaptions
End Function

Private Sub FilterPivotField(ByVal pvf As PivotField, ByVal vVisibleItems As Variant)
    Dim bPivotItemExists As Boolean
    
'--filters the specified pivotfield to make visible only the items passed
'     in vVisibleItems- if they exist as pivotitems.
'--uses a dictionary to store all non-missing pivotitems for that pivotfield
'     vVisibleItems that exist in dictionary are denoted by dictionary items that match
'     the corresponding keys.
'--attempts to optimize filtering based on number of items and
'     pivotfield orientation.

 Dim dctPviCaptions As Object
 Dim lNdx As Long, lVisibleItemCount As Long
 Dim sItem As String, sVisibleItem As String, sCaption As String
 Dim vKey As Variant
 
 If pvf.Orientation = xlHidden Then GoTo ExitProc
 If pvf.Orientation = xlDataField Then GoTo ExitProc
 
 Set dctPviCaptions = dctReadPivotItemsToDictionary(pvf:=pvf)
 dctPviCaptions.CompareMode = 1 'TextCompare
 
 '--validate vlist is array
 If Not IsArray(vVisibleItems) Then vVisibleItems = Array(vVisibleItems)
 
 For lNdx = LBound(vVisibleItems) To UBound(vVisibleItems)
   sItem = vVisibleItems(lNdx)
   If sItem = "(All)" Then
      lVisibleItemCount = -1
      Exit For
   ElseIf dctPviCaptions.Exists(sItem) Then
      '--mark to be made visible
      dctPviCaptions(sItem) = sItem
      sVisibleItem = sItem
      lVisibleItemCount = lVisibleItemCount + 1
   End If
 Next lNdx
   
 With pvf
   '--attempts to optimize filtering based on number of items and
   '     pivotfield orientation.
   Select Case True
      Case lVisibleItemCount = -1
         '---"(All)"
         .ClearAllFilters
         
      Case lVisibleItemCount = 0
         If mbDISPLAY_WARNINGS Then
         '--since no items match, alert user
            MsgBox "No records meet criteria for " & vbCr _
               & "PivotTable: " & .Parent.Name & vbCr _
               & "PivotField: " & .Name
         End If
      Case lVisibleItemCount = 1 And .Orientation = xlPageField
         .ClearAllFilters
         .CurrentPage = sVisibleItem
      
      Case Else '--multiple pagefield items or row/colummfield
         .Parent.ManualUpdate = False
         If (.Orientation = xlPageField) And _
            (.EnableMultiplePageItems = False) Then
            '--if changing to multiple page items, need to clearallfilters
            '  otherwise "(Multiple Items)" caption may not be displayed
            .ClearAllFilters
            .EnableMultiplePageItems = True
            '--step through each pivotitem, hide those not marked as visible
            For Each vKey In dctPviCaptions.Keys
               If Len(dctPviCaptions(vKey)) = 0 Then
                  .PivotItems(vKey).Visible = False
               End If
            Next vKey
         Else
            '--multiple pagefield items(filters not cleared) or row/colummfield
            '--ensure at least one visible item
            .PivotItems(sVisibleItem).Visible = True
            
            '--step through each pivotitem. only change visible state if needed
            For Each vKey In dctPviCaptions.Keys
               If (Len(dctPviCaptions(vKey)) = 0) = .PivotItems(vKey).Visible Then
                  .PivotItems(vKey).Visible = Not .PivotItems(vKey).Visible
               End If
            Next vKey
         End If
         .Parent.ManualUpdate = False
   End Select
 End With
 
ExitProc:
 
End Sub

Private Function vGetVisibleItemList(pvt As PivotTable, sField As String) As Variant
'---Stores visible items in PivotField sField in an array

 Dim sVisibleItems() As String
 Dim pviItem As PivotItem
 Dim i As Long
    
 With pvt.PivotFields(sField)
   If .Orientation = xlPageField And _
      .EnableMultiplePageItems = False Then
      ReDim sVisibleItems(1)
      sVisibleItems(0) = .CurrentPage
   Else
      For Each pviItem In .PivotItems
         If pviItem.Visible Then
            i = i + 1
            ReDim Preserve sVisibleItems(i)
            sVisibleItems(i - 1) = pviItem
         End If
      Next
   End If
 End With

 vGetVisibleItemList = sVisibleItems
End Function

 

[Jakub_S]

Hello Jerry,

thank you very much for your incredible effort, it will help me tons.
I am sorry for my late thanks, but I've had no time to give your code a try this week.

Hi Jakub, I ended up rewriting most of this code. Below is some code based on the example that you gave. Replace all the previous code with these procedures.