Forum Discussion

byte99's avatar
byte99
Copper Contributor
Jan 16, 2021
Solved

Way to automatically expand all pivot tables in a notebook?

  I'm using Excel in Office 365 for Windows (lastest version).   One of my systems generates an Excel notebook with a few hundred tabs, about 50 of which contain pivot tables.  All the pivot table...
  • Wyn Hopkins's avatar
    Wyn Hopkins
    Jan 18, 2021

    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


     

Resources