Forum Discussion
Way to automatically expand all pivot tables in a notebook?
Hi byte99
Not my best work but something like this. You could either put this code in your personal macro workbook (and assign a short cut key, or assign it to Quick Access Toolbar button) for repeated use. Or (simpler to start with) press Alt F11 on your Pivot Table file and paste this code into the Workbook windowSub ExpandAll() Dim pt As PivotTable Dim pf As PivotField Dim pi As PivotItem Dim iFieldCount As Long Dim iPosition As Long Dim sh As Worksheet Dim wkbkTarget As Workbook Application.ScreenUpdating = False Set wkbkTarget = ActiveWorkbook For Each sh In wkbkTarget.Worksheets 'If there is any pivot table on the sheet If sh.PivotTables.Count > 0 Then sh.Activate 'Expand the lowest position field in the Rows area 'that is currently expanded (showing details) For Each pt In sh.PivotTables 'Create reference to 1st pivot table on sheet 'Can be changed to reference a specific sheet or pivot table. ' Set pt = ActiveSheet.PivotTables(1) 'Count fields in Rows area minus 1 (last field can't be expanded) iFieldCount = pt.RowFields.Count - 1 'Loop by position of field For iPosition = 1 To iFieldCount 'Loop fields in Rows area For Each pf In pt.RowFields 'If position matches first loop variable then If pf.Position = iPosition Then 'Loop each pivot item For Each pi In pf.PivotItems 'If pivot item is collapsed then If pi.ShowDetail = False Then 'Expand entire field pf.ShowDetail = True 'Exit the loop GoTo NextPT End If Next pi End If Next pf 'If the Exit Sub line is not hit then the 'loop will continue to the next field position Next iPosition NextPT: Next pt End If Next sh Set wkbkTarget = Nothing Application.ScreenUpdating = True End Sub
As I've never written an Excel Macro before, I'm not quite following how to extend that code to loop through all the sheets in a Workbook.
I tried the Macro you linked, and it does work. To execute it, I just need to open the Workbook containing that Macro (which I downloaded from your supplied link). Then if I open one of my Workbooks, and go to Developer->Macros, I can select the Macro I need (since the Workbook with the Macro is open, it can access its Macros), and Run. But, as you know, this works for the open sheet only.
I see your Macro has the following statement:
Call ExpandPivotFields
But how will this call the specific Macro I need, since the link contains a package consisting of several different Macros?:
Should I substitute the actual name of the Macro I want, which is "Expand_Entire_RowField" for "ExpandPivotFields"?
Alternately, the structure of the Macro I need is:
**************
Option Explicit
Sub ExpandEntireRowField ()
[Several lines of code]
End Sub
***********************
So could I insert the above code into your code to create the needed loop? If so, how would I do that?
[I also posted that question on the link itself, asking them how to extend their code to loop through all the sheets in a Workbook.]
Hi byte99
Not my best work but something like this. You could either put this code in your personal macro workbook (and assign a short cut key, or assign it to Quick Access Toolbar button) for repeated use. Or (simpler to start with) press Alt F11 on your Pivot Table file and paste this code into the Workbook window
Sub ExpandAll()
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Dim iFieldCount As Long
Dim iPosition As Long
Dim sh As Worksheet
Dim wkbkTarget As Workbook
Application.ScreenUpdating = False
Set wkbkTarget = ActiveWorkbook
For Each sh In wkbkTarget.Worksheets
'If there is any pivot table on the sheet
If sh.PivotTables.Count > 0 Then
sh.Activate
'Expand the lowest position field in the Rows area
'that is currently expanded (showing details)
For Each pt In sh.PivotTables
'Create reference to 1st pivot table on sheet
'Can be changed to reference a specific sheet or pivot table.
' Set pt = ActiveSheet.PivotTables(1)
'Count fields in Rows area minus 1 (last field can't be expanded)
iFieldCount = pt.RowFields.Count - 1
'Loop by position of field
For iPosition = 1 To iFieldCount
'Loop fields in Rows area
For Each pf In pt.RowFields
'If position matches first loop variable then
If pf.Position = iPosition Then
'Loop each pivot item
For Each pi In pf.PivotItems
'If pivot item is collapsed then
If pi.ShowDetail = False Then
'Expand entire field
pf.ShowDetail = True
'Exit the loop
GoTo NextPT
End If
Next pi
End If
Next pf
'If the Exit Sub line is not hit then the
'loop will continue to the next field position
Next iPosition
NextPT:
Next pt
End If
Next sh
Set wkbkTarget = Nothing
Application.ScreenUpdating = True
End Sub
Thanks Wyn--works beautifully!