Creating all pivot tables on one sheet simulates each other in terms of rows expanding and contracting

Question

Ok, I am new to VBA, but I know that this should be possible. I spent some time coding Android applications, but I would not call myself almost an expert, perhaps not even intermediate, to be honest. However, alas, excel does not use java. Here is my problem:

All you need to do is 6 other pivot tables on one sheet to simulate what I will call the main pivot table. The only feature that it should simulate, although (at the moment, I suppose), is when the primary expands / collapses, the rest should follow suit.

I assume that the code will look like onclicklistener in java, and when the code “hears” a click for crash or extension in the main pivot table, it just applies the same crash or extension to the other six. The remaining 6 anchor points will always have the same row labels , therefore, the error in transferring the “location” of the click from the main to the rest should never be a problem.

I tried to write the extension of one of the row labels in the pivot table and got this code.

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

I know, however, that this is the encoding to execute this extension (and ShowDetail = False will crash it). I think that I need, as I said, the listener to “hear” a click of some extension / break of the primary pivot table, a way to store / transfer information about which label label was clicked (“location”, click if you do it) and then the general version of the above code to execute on another 6, I assume that sorting is used for the loop.

Am I on the right track to help guys? Thanks a ton, as always.

Answer 1

This should work for you:

Put this in the standard module (this is a less efficient method - because it checks all the 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 change, you need to put it in your Sheet1 code (let me know if you need help with this).

 Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable) Call LinkPivotTables_ByFieldItemName_ToShowDetail(Target) End Sub 

It will work if all your pivot tables are on the same sheet. You may need to first copy / paste into a text block or other text editor, because I did not worry about line length restrictions (watch out for word wraps).

EDIT / Add:

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

EDIT2 / ADDITION2 - EFFICIENCY METHOD:

This method will significantly increase efficiency, but you will need to say in which field you want to synchronize (it will not synchronize all of them):

 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 need to manually indicate in this line which field you want to synchronize:

 PivotFieldIndex = "Year" 

I found several other solutions on the Internet that use the same cycling method to synchronize pivot tables - the problem is that they all face the same performance issues when you get decent tables with a decent size. They work around this problem a bit by including an IF statement that checks the value of Item.ShowDetail before setting it up (because it takes a lot more time to determine it than it does to check). Good luck.