Making all pivot tables on one sheet mimic each other in terms of rows expanding and collapsing

Question

Alright, I'm new to VBA but I know this has to be possible. I spent a while coding android applications, but I wouldn't call myself nearly an expert, probably not even intermediate to be honest. However, alas, excel doesn't use java. Here's my problem:

All I need is to make 6 other pivot tables on the same sheet mimic what I will call the primary pivot table. The only feature it needs to mimic though (for now I suppose) is when the primary expands/collapses, the others should follow suit.

I'm guessing that the code will be similar to an onclicklistener in java and when the code "hears" a click for a collapse or expansion in the primary pivot table, it just applies that same collapse or expansion to the other six. The other 6 pivots will always have the same row labels, so an error in carrying over the "location" of the click from the primary to the others should never be a problem.

I tried recording the expansion of one of the row labels in my pivot table and got this code back.

ActiveSheet.PivotTables("PivotTable1").PivotFields("Year").PivotItems("2005"). _
    ShowDetail = True

I know though, that this is the coding for executing that expansion (and ShowDetail = False would make it collapse). I think what I'm needing is like I said, a listener to "hear" the click of any expansion/collapse of the primary pivot table, a way to store/carry over information on what row label was clicked (the "location" of the click if you will), and then a generic version of the above code to execute on the other 6 using I'm guessing a for loop of sorts.

Am I on the right track slash any help guys? Thanks a ton as always.

Answer 1

This should work for you:

Put this in a standard module(this is the less efficient method - because it checks all fields):

Sub LinkPivotTables_ByFieldItemName_ToShowDetail(pt As PivotTable)

Dim wkb As Workbook
Set wkb = ThisWorkbook

Dim wks As Worksheet
Set wks = wkb.Sheets(1)

Dim PivotTableIndex As Integer
Dim PivotFieldIndex As Integer
Dim PivotItemIndex As Integer

Dim PivotFieldIndexName As String
Dim PivotItemIndexName As String

Dim BoolValue As Boolean

Application.ScreenUpdating = False
Application.EnableEvents = False

On Error Resume Next

    For PivotFieldIndex = 1 To pt.PivotFields.Count

    PivotFieldIndexName = pt.PivotFields(PivotFieldIndex).Name

        For PivotItemsIndex = 1 To pt.PivotFields(PivotFieldIndex).PivotItems.Count

        PivotItemIndexName = pt.PivotFields(PivotFieldIndex).PivotItems(PivotItemsIndex).Name
        BoolValue = pt.PivotFields(PivotFieldIndex).PivotItems(PivotItemsIndex).ShowDetail

            For PivotTableIndex = 1 To wks.PivotTables.Count

                ' This If statement will dramatically increase efficiency - because it takes a long long time to set the value but it doesn't take long to check it.
                If wks.PivotTables(PivotTableIndex).PivotFields(PivotFieldIndexName).PivotItems(PivotItemIndexName).ShowDetail <> BoolValue Then
                    wks.PivotTables(PivotTableIndex).PivotFields(PivotFieldIndexName).PivotItems(PivotItemIndexName).ShowDetail = BoolValue
                End If

            Next PivotTableIndex

        Next PivotItemsIndex

    Next PivotFieldIndex


Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub

Then to automatically run this macro on any PivotTable edit you need to put this in your Sheet1 code(let me know if you need help doing that).

Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)

    Call LinkPivotTables_ByFieldItemName_ToShowDetail(Target)

End Sub

It will work if all your pivot tables are on sheet one. You might have to copy/paste into wordpad or another text editor first because I didn't worry about line length limits(watch out for word wrap).

EDIT/ADDITION:

This is how you put code on a specific sheet object:

EDIT2/ADDITION2 - EFFICIENCY METHOD:

This method will dramatically increase the efficiency but you will have to tell it specifically which Field you want to be synced up(it won't sync them all):

Sub LinkPivotTables_ByFieldItemName_ToShowDetail(pt As PivotTable)  'takes as argument - pt As PivotTable

Dim wkb As Workbook
Set wkb = ThisWorkbook

Dim wks As Worksheet
Set wks = wkb.Sheets(1)

Dim PivotTableIndex As Integer
Dim PivotItemIndex As Integer
Dim PivotFieldIndex As String
Dim BoolValue As Boolean
Dim ItemName As String

Application.ScreenUpdating = False
Application.EnableEvents = False

PivotFieldIndex = "Year"

On Error Resume Next


        For PivotItemsIndex = 1 To pt.PivotFields(PivotFieldIndex).PivotItems.Count

        BoolValue = pt.PivotFields(PivotFieldIndex).PivotItems(PivotItemsIndex).ShowDetail
        ItemName = pt.PivotFields(PivotFieldIndex).PivotItems(PivotItemsIndex).Name

            For PivotTableIndex = 1 To wks.PivotTables.Count

                ' This If statement will dramatically increase efficiency - because it takes a long long time to set the value but it doesn't take long to check it.
                If wks.PivotTables(PivotTableIndex).PivotFields(PivotFieldIndex).PivotItems(PivotItemsIndex).ShowDetail <> BoolValue Then
                    wks.PivotTables(PivotTableIndex).PivotFields(PivotFieldIndex).PivotItems(PivotItemsIndex).ShowDetail = BoolValue
                End If

            Next PivotTableIndex

        Next PivotItemsIndex

Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub

You will have to manually tell it in this line what field you want synced up:

PivotFieldIndex = "Year"

I've found several other solutions online that use the same looping method to sync up pivot tables - the problem is that they all run into the same efficency problems when you get decent sized pivot tables. These somewhat get around that issue by including an IF statement that checks the Item.ShowDetail value before it sets it(because it takes alot longer to set the value than it does to just check it). Good Luck.