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.

Solution

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.

Comments

[dootcher]

So, I put the code in the right places (first bit to a module and the second bit to the page's code), but its still not working it seems. Aside from the mimic pivots not doing anything, I think something is getting caught up somewhere because excel becomes unresponsive for about 15 seconds after expanding/collapsing a row in the main pivot. Since the name of the sheet isn't Sheet1, I changed where I think you're defining the sheet to run the macro on to "Set wks = wkb.ActiveSheet" But, alas, that didn't work either. Any thoughts?

[dootcher]

Just for knowledge sake, the name of the sheet is actually "Combined MD - Totals" if/since that makes a difference.

[Stepan1010]

Hey dootcher, Sheets(1) is not a name, it is a reference to the first sheet in the workbook. You don't need to change that.(at least not till we get it working for you). You don't need to change anything in the code as long as all your pivot tables are on the first sheet(the one farthest to the left) in you workbook. I tested everything out again and it all works fine so let me know. What version of excel are you using?

[dootcher]

I'm using 2010. I switched the code back to your original referencing the first sheet in the workbook and made sure the sheet was in the right place and it still didn't work sadly. Now actually, when I expand any of the rows, excel just breaks down and stops responding for 60+ seconds. The only thing different I'm seeing from the screenshot you posted is my sheets' code is in a separate folder (Microsoft Excel Objects) from my module (Modules) however they're both in the same project, so I assume that shouldn't matter.

[dootcher]

I'm going to try making a simpler version of this and see if its just my workbook.

[dootcher]

Well, when I made the new workbook, it actually worked - but very slowly. I think I know the problem now with the original. The new simpler version only has 3 row labels, but the original has 10, so I think that it's working in the original, just really really slowly. Is there anyway to get around that?

[Stepan1010]

Hi dootcher, that folder difference isn't going to affect anything - I have my folders hidden in my preferences. Since you are using 2010(the same version as me) I am not sure what the issue could be. I agree that starting a file from scratch with some simple pivot tables is good idea.

[dootcher]

I think I understand what the code is doing, but I don't know how to create new code myself. If I understand it correctly, every time the pivot table is updated, you're using a loop to check each row label to see if its expanded or collapsed and applying the same thing to each row label of all the other pivots. Is there anyway to just "listen" for the one that is changed and only apply expand/collapse that one row label rather than waste time with the other row labels that weren't touched?

[Stepan1010]

I have a fairly slow computer - 3 GHz single core, 1 GB RAM and it runs in a little under a second with 15 pivot tables with 20 field items each. There is probably a better way to do this by just "listening" as you say - however for my purposes this is the best solution I am aware of. Good Luck.

[dootcher]

That's extremely weird. I'm on a 1.6 dual core with 3.5gigs of ram and its taking FOREVER. Is there anyway you can send me/upload your test file that you made? I'm curious to see how fast your file runs on my machine.

[Stepan1010]

Hey Dootcher - I don't want to beat a dead horse but I totally forgot about an extremely easy way to make these subs 20 times more efficient. I totally rewrote the answer to reflect these two options. They are actually practical now - even for very large pivot tables.

[dootcher]

Wow! It is SO much faster and that's even after the remarkable improvement you made in the second attempt at the problem! It's now down to about 2 seconds tops, usually under a second for each expansion/collapse! Thank you again! A true life saver!