Thread: Multiple pivots with the same row - how do i make them change at the same time?

Perhaps:

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
Dim ptTable As PivotTable, ptItem As PivotItem
On Error GoTo ExitPoint
Application.EnableEvents = False
For Each ptTable In ActiveSheet.PivotTables
    If ptTable <> Target Then
        With ptTable.PivotFields("Media")
            For Each ptItem In .PivotItems
                ptItem.Visible = Target.PivotFields("Media").PivotItems(ptItem.Value).Visible
            Next ptItem
        End With
    End If
Next ptTable
ExitPoint:
Application.EnableEvents = True
End Sub

If not, post a sample.

I've tried combining the 2 sets of code above to achieve this but cannot get it to work.

Please post a small sample file which illustrates all PT's in place and their respective structures. I won't look at it today unfortunately but will do so tomorrow.

Is it possible to adapt this so it only happens on a button click too please? I have other macros to add in more data fields and when i run these the code below runs and slows things down.

I would argue it's better to keep this tied to the PT event itself else PT functionality and results become detached which would be odd... better to toggle events in your "other" code as and where appropriate such that the PT update event does not fire in first instance.

Just quickly... you make reference to "multiple page field items" which leads me to believe you're running this in XL2007 specifically - is that correct ?

If so it would IMO be best to upload a 2007 file ... reason being PT functionality differs between 2007 and earlier versions - for example pre XL2007 there is no multi select Page filter functionality ... as such the VBA for controlling PT's will differ between versions and it makes sense to code exclusively in the version you're using. Of course if it's your intention to use the file in multiple versions then it's a different matter.

davellll,

here is some code that should work if (and only if) the Pivots are created in XL2007 file (ie not in compatibility mode)

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
Dim ptTable As PivotTable, ptField As PivotField, ptItem As PivotItem
Dim vFields As Variant, lngField As Long, boolMulti As Boolean
On Error GoTo ExitPoint
Application.ScreenUpdating = False
Application.EnableEvents = False
vFields = Array("Customer", "Month_Trial_Began", "Payment_Interval", "Media", "Guide")
For lngField = LBound(vFields) To UBound(vFields) Step 1
    For Each ptTable In ActiveSheet.PivotTables
        If ptTable <> Target Then
            Set ptField = ptTable.PivotFields(vFields(lngField))
            Select Case ptField.Orientation
                Case xlRowField
                    For Each ptItem In ptField.PivotItems
                        ptItem.Visible = Target.PivotFields(vFields(lngField)).PivotItems(ptItem.Value).Visible
                    Next ptItem
                Case xlPageField
                    boolMulti = Target.PivotFields(vFields(lngField)).EnableMultiplePageItems
                    With ptField
                        .ClearAllFilters
                        Select Case boolMulti
                            Case False
                                .CurrentPage = Target.PivotFields(vFields(lngField)).CurrentPage.Value
                            Case True
                                .CurrentPage = "(All)"
                                For Each ptItem In Target.PivotFields(vFields(lngField)).PivotItems
                                    .PivotItems(ptItem.Name).Visible = ptItem.Visible
                                Next ptItem
                                .EnableMultiplePageItems = boolMulti
                        End Select
                    End With
                    boolMulti = False
            End Select
            Set ptField = Nothing
        End If
    Next ptTable
Next lngField
ExitPoint:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

In the above code I have as per your code comments consolidated all of the fields into the one process (ie Page Fields and Row Fields)

I've attached a working example (.xlsm as outlined above)


EDIT:
I should add you can still use multi page item functionality in PT's created in earlier versions but it requires moving the Page Field to the Row Field, making selections, moving back to Page Field... invariably be a pain.
If running earlier PT's in 2007 you can use MultiPageField selection but in code terms the visible status of the pivot items in the page field is not available to the other PT's ... so to mimic you would need to (I suspect) action the above
(ie move the field in both Target and subsequent PT's from Page to Row to ensure appropriate selections and then move back to Page Field

Ah ok... I understand now - that makes sense... in my (late) edit to prior post I think I highlighted the issue you will face on that front... I'm in the midst of something else right now but I will run some tests on another client machine on which I'm running 2002 and I'll see what I can come up with re: hidden page items and replication thereof.

As things stand I think you can in essence disregard the prior code for the time being (unfortunately).

Ignoring issue of multi page item filters for the time being the below should do the remainder... ie can replace your existing code.

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
Dim ptTable As PivotTable, ptField As PivotField, ptItem As PivotItem
Dim vFields As Variant, lngField As Long, boolMulti As Boolean
On Error GoTo ExitPoint
Application.ScreenUpdating = False
Application.EnableEvents = False
vFields = Array("Customer", "Month_Trial_Began", "Payment_Interval", "Media", "Guide")
For lngField = LBound(vFields) To UBound(vFields) Step 1
    For Each ptTable In ActiveSheet.PivotTables
        If ptTable <> Target Then
            Set ptField = ptTable.PivotFields(vFields(lngField))
            Select Case ptField.Orientation
                Case xlRowField
                    For Each ptItem In ptField.PivotItems
                        ptItem.Visible = Target.PivotFields(vFields(lngField)).PivotItems(ptItem.Value).Visible
                    Next ptItem
                Case xlPageField
                    ptField.CurrentPage = Target.PivotFields(vFields(lngField)).CurrentPage.Value
            End Select
            Set ptField = Nothing
        End If
    Next ptTable
Next lngField
ExitPoint:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Not sure how badly this will perform but the below works on my 2002 version and will cater for multiple page item selection etc...

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
Dim ptTable As PivotTable, ptField As PivotField, ptFieldT As PivotField, ptItem As PivotItem
Dim vFields As Variant, lngField As Long, boolMulti As Boolean
On Error GoTo ExitPoint
Application.ScreenUpdating = False
Application.EnableEvents = False
vFields = Array("Customer", "Month_Trial_Began", "Payment_Interval", "Media", "Guide")
For lngField = LBound(vFields) To UBound(vFields) Step 1
    For Each ptTable In ActiveSheet.PivotTables
        If ptTable <> Target Then
            Set ptField = ptTable.PivotFields(vFields(lngField))
            Set ptFieldT = Target.PivotFields(vFields(lngField))
            Select Case ptFieldT.Orientation
                Case xlRowField
                    For Each ptItem In ptField.PivotItems
                        ptItem.Visible = Target.PivotFields(vFields(lngField)).PivotItems(ptItem.Value).Visible
                    Next ptItem
                Case xlPageField
                    With ptFieldT
                        ptField.CurrentPage = .CurrentPage.Value
                        If .CurrentPage.Value = "(All)" Then
                            .Orientation = xlRowField
                            For Each ptItem In ptField.PivotItems
                                ptItem.Visible = .PivotItems(ptItem.Name).Visible
                            Next ptItem
                            .Orientation = xlPageField
                            .Position = Target.PageFields.Count - lngField
                        End If
                    End With
            End Select
            Set ptField = Nothing
            Set ptFieldT = Nothing
        End If
    Next ptTable
Next lngField
ExitPoint:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

I've had a look at this more thoroughly now and the problem is actually quite an obvious one but one that I did not account for in testing...namely items which exist in one PT may not exist in another ... and this could be caused by a number of issues...

a) values are simply different

b) legacy items exist in the item listings

Now point b) is an interesting one and one that made me think a little more about this... in general given you want to give each PT the most opportunity of being identical you need to ensure that when you refresh one PT you refresh them all... however the act of Refresh is different to making selections etc (ie the former is based on a premise that underlying data has altered) yet refreshing via the Refresh button will

1) only refresh the relevant cache

2) invoke the update event

given the possibility of problem a) we then need to try and restrict the opportunity for error by not invoking the update event on a standard refresh...how to do this ?

Well I thought about it and came up with the idea of disabling/creating some custom controls on the right-click PT menu, ie into ThisWorkbook:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call ToggleControl("Query and Pivot", 459, True)
End Sub

Private Sub Workbook_Open()
Call ToggleControl("Query and Pivot", 459, False)
End Sub

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Run "DeleteRC"
Run "AddRC"
End Sub

and then into a new module

Private Module

Public Sub ToggleControl(strCB As String, lngID As Long, boolStatus As Boolean)
Application.CommandBars(strCB).FindControl(ID:=lngID).Enabled = boolStatus
End Sub

Public Sub AddRC()
Dim ctrl As CommandBarControl
With Application.CommandBars("PivotTable Context Menu")
    'disable default refresh
    .FindControl(ID:=459).Enabled = False
    'add refresh all icon
    Set ctrl = .Controls.Add(Type:=1, Before:=1)
    With ctrl
        .Caption = "Refresh All"
        .OnAction = "PTRefresh"
    End With
    Set ctrl = Nothing
End With
End Sub

Public Sub DeleteRC()
Dim ctrl As CommandBarControl
For Each ctrl In Application.CommandBars("PivotTable Context Menu").Controls
    Select Case ctrl.Caption
        'remove custom control
        Case "Refresh All"
            ctrl.Delete
        'enable default control
        Case "Refresh"
            ctrl.Enabled = True
    End Select
Next ctrl
End Sub

The code for the refresh All should for sake of clarity reside in a new & separate module

Private Module 

Public Sub PTRefresh()
Dim PT As PivotTable
On Error GoTo ExitPoint
Application.EnableEvents = False
For Each PT In ActiveSheet.PivotTables
    With PT.PivotCache
        .MissingItemsLimit = xlMissingItemsNone
        .Refresh
    End With
Next PT
ExitPoint:
Application.EnableEvents = True
End Sub

What all of the above will do is ensure you can only refresh All PT's simultaneously via the right-click menu and "new" option added namely: Refresh All ... and
when this is done the BeforeUpdate event is NOT invoked (it will also remove "legacy" items from any/all lists)

Now the above still does not resolve the problem that given the data sources for each PT are different it's still quite possible that items will exist in one PT but not in another, for ex. you may run an Edit->Replace on all which columns but forget to update the last one meaning the same options do not exist in all PT's ... this may be highly unlikely however it is still a possibility.

On that basis you then need to think about adding handlers around the setting of item visibility so I would change the existing Select Case section to

Select Case ptFieldT.Orientation
    Case xlRowField
        On Error Resume Next
        For Each ptItem In ptField.PivotItems
            ptItem.Visible = Target.PivotFields(vFields(lngField)).PivotItems(ptItem.Value).Visible
        Next ptItem
        On Error GoTo ExitPoint
    Case xlPageField
        With ptFieldT
            On Error Resume Next
            ptField.CurrentPage = .CurrentPage.Value
            On Error GoTo ExitPoint
            If .CurrentPage.Value = "(All)" Then
                .Orientation = xlRowField
                On Error Resume Next
                For Each ptItem In ptField.PivotItems
                    ptItem.Visible = .PivotItems(ptItem.Name).Visible
                Next ptItem
                On Error GoTo ExitPoint
                .Orientation = xlPageField
                .Position = Target.PageFields.Count - lngField
            End If
        End With
End Select

And all of that together *should* I think resolve your issue(s) ?

Beware!

I have found another little problem with this macro that is easy enough to fix. If your data has blanks in it the pivot table will have a pivot item called "(Blank)" in it, but of course your actual data is not "(Blank)" it is "". Therefore the other pivot tables will not update if you wish to hide/show blanks.

So my solution is to simply find and replace all "" with "(Blank)" within all the pivot tables data regions.

Also beware of sorting your various pivot tables differently as this will effect them being 'lined up' i found that sticking to a manual sort was the safest option for my data. Changing to ascending seemed to stop the macro working.

At last I can actually contribute a little something rather than asking Qs!

DaveL