Pivot Table List Macros

For troubleshooting Pivot Table refresh errors, use these macros to create a list of pivot tables in the active workbook, with key information about each pivot table.

Also see: List all Pivot Fields with Details

List All Pivot Tables - Basic List

Use this macro to create a list of all the pivot tables in the active workbook.

The code checks each worksheet, and for each pivot table on that sheet, it lists the following information:

• Worksheet name
• Pivot Table name
• Pivot Cache index number
• Source Data name or range address

Sub ListWbPTsBasic()
Dim ws As Worksheet
Dim pt As PivotTable
Dim wsPL As Worksheet
Dim RowPL As Long
Dim RptCols As Long
Dim CountPT As Long

On Error Resume Next

For Each ws In ActiveWorkbook.Worksheets
  For Each pt In ws.PivotTables
    CountPT = CountPT + 1
    If CountPT > 0 Then Exit For
  Next pt
  If CountPT > 0 Then Exit For
Next ws

If CountPT = 0 Then
  MsgBox "No pivot tables in this workbook"
  GoTo exitHandler
End If

RptCols = 4
Set wsPL = Worksheets.Add
RowPL = 2

With wsPL
  .Range(.Cells(1, 1), .Cells(1, RptCols)).Value _
    = Array("Worksheet", _
        "PT Name", _
        "PivotCache", _
        "Source Data")
End With

For Each ws In ActiveWorkbook.Worksheets
  For Each pt In ws.PivotTables
     With wsPL
        .Range(.Cells(RowPL, 1), _
            .Cells(RowPL, RptCols)).Value _
          = Array(ws.Name, _
              pt.Name, _
              pt.CacheIndex, _
              pt.SourceData)
      End With
     RowPL = RowPL + 1
   Next pt
Next ws

With wsPL
  .Rows(1).Font.Bold = True
  .Range(.Cells(1, 1), .Cells(1, RptCols)) _
      .EntireColumn.AutoFit
End With

exitHandler:
  Set wsPL = Nothing
  Set ws = Nothing
  Set pt = Nothing
  Exit Sub

End Sub

List All Pivot Table – Headings

NOTE: This macro has been updated, and the new version is below, in the List All Pivot Tables - Details macro, below. All of the columns from the old Headings macro are included in the new Details macro, but the following heading labels are different in the new macro:

• SD Cols - Data Cols
• SD Heads - Data Heads
• Fix - Head Fix

List All Pivot Tables - Details

Use this macro to create a list of all the pivot tables in the active workbook, with details on the source data, and possible conflicts with other pivot tables, or missing headings. This can help if you get an error message when refreshing pivot tables, such as:

• "The PivotTable field name is not valid. To create a PivotTable report, you must use data that is organized as a list with labeled columns. If you are changing the name of a PivotTable field, you must type a new name for the field."

or

• "A PivotTable report cannot overlap another PivotTable report."

This video shows how the macro helps with trouble shooting, and there are written details below the video.

Pivot Table Details List Macro

The code checks each worksheet, and for each pivot table on that sheet, it lists the following information:

• Worksheet name
• Number of pivot tables on sheet
• Pivot Table name
• Pivot Table range (with hyperlink so you can check it easily)
• Other pivot tables in the same rows - might cause overlap
• Other pivot tables in the same columns - might cause overlap
• Pivot Cache index number
• Source Data name or range address

Also, if the source data is a list in the same Excel workbook, and not in the Data Model, this macro shows the following details about the source date:

• Number of records
• Number of columns
• Number of heading cells that contain values
• Head Fix -- an X if number of columns does not match number of headings
• Latest refresh date for the pivot cache

Pivot Table Details List Code

Add this macro to a regular code module in your workbook.

NOTE: This is an improved version of "List All Pivot Table – Headings"

Sub ListWbPTsDetails()
Dim ws As Worksheet
Dim wsSD As Worksheet
Dim lstSD As ListObject
Dim pt As PivotTable
Dim rngPT As Range
Dim wsPL As Worksheet
Dim rngSD As Range
Dim rngHead As Range
Dim pt2 As PivotTable
Dim rngPT2 As Range
Dim rCols As Range
Dim rRows As Range
Dim RowPL As Long
Dim RptCols As Long
Dim SDCols As Long
Dim SDHead As Long
Dim lBang As Long
Dim nm As Name
Dim strSD As String
Dim strRefRC As String
Dim strRef As String
Dim strWS As String
Dim strAdd As String
Dim strFix As String
Dim lRowsInt As Long
Dim lColsInt As Long
Dim CountPT As Long
On Error Resume Next

RptCols = 13
RowPL = 2

For Each ws In ActiveWorkbook.Worksheets
  For Each pt In ws.PivotTables
    CountPT = CountPT + 1
    If CountPT > 0 Then Exit For
  Next pt
  If CountPT > 0 Then Exit For
Next ws

If CountPT = 0 Then
  MsgBox "No pivot tables in this workbook"
  GoTo exitHandler
End If

Set wsPL = Worksheets.Add

With wsPL
  .Range(.Cells(1, 1), .Cells(1, RptCols)).Value _
    = Array("Worksheet", _
        "Ws PTs", _
        "PT Name", _
        "PT Range", _
        "PTs Same Rows", _
        "PTs Same Cols", _
        "PivotCache", _
        "Source Data", _
        "Records", _
        "Data Cols", _
        "Data Heads", _
        "Head Fix", _
        "Refreshed")
End With

For Each ws In ActiveWorkbook.Worksheets
  For Each pt In ws.PivotTables
    lRowsInt = 0
    lColsInt = 0
    Set rngPT = pt.TableRange2
      
    For Each pt2 In ws.PivotTables
      If pt2.Name <> pt.Name Then
        Set rngPT2 = pt2.TableRange2
        Set rRows = Intersect(rngPT.Rows.EntireRow, _
            rngPT2.Rows.EntireRow)
        If Not rRows Is Nothing Then
          lRowsInt = lRowsInt + 1
        End If
        Set rCols = Intersect(rngPT.Columns.EntireColumn, _
            rngPT2.Columns.EntireColumn)
        If Not rCols Is Nothing Then
          lColsInt = lColsInt + 1
        End If
      End If
    Next pt2
    
    If pt.PivotCache.SourceType = 1 Then  'xlDatabase
      Set nm = Nothing
      strSD = ""
      strAdd = ""
      strFix = ""
      SDCols = 0
      SDHead = 0
      Set rngHead = Nothing
      Set lstSD = Nothing
      
      strSD = pt.SourceData
      
      'worksheet range?
      lBang = InStr(1, strSD, "!")
      If lBang > 0 Then
        strWS = Left(strSD, lBang - 1)
        strRefRC = Right(strSD, Len(strSD) - lBang)
        strRef = Application.ConvertFormula( _
              strRefRC, xlR1C1, xlA1)
        Set rngSD = Worksheets(strWS).Range(strRef)
        SDCols = rngSD.Columns.Count
        Set rngHead = rngSD.Rows(1)
        SDHead = WorksheetFunction.CountA(rngHead)
        GoTo AddToList
      End If
      
      'named range?
      Set nm = ThisWorkbook.Names(strSD)
      If Not nm Is Nothing Then
        strAdd = nm.RefersToRange.Address
        SDCols = nm.RefersToRange.Columns.Count
        Set rngHead = nm.RefersToRange.Rows(1)
        SDHead = WorksheetFunction.CountA(rngHead)
        GoTo AddToList
      End If
      
      'list object?
        For Each wsSD In ActiveWorkbook.Worksheets
          Set lstSD = wsSD.ListObjects(strSD)
          If Not lstSD Is Nothing Then
            strAdd = lstSD.Range.Address
            SDCols = lstSD.Range.Columns.Count
            Set rngHead = lstSD.HeaderRowRange
            SDHead = WorksheetFunction.CountA(rngHead)
            GoTo AddToList
          End If
        Next
    End If
    
AddToList:
     If SDCols <> SDHead Then strFix = "X"
     With wsPL
        .Range(.Cells(RowPL, 1), _
            .Cells(RowPL, RptCols)).Value _
          = Array(ws.Name, _
              ws.PivotTables.Count, _
              pt.Name, _
              pt.TableRange2.Address, _
              lRowsInt, _
              lColsInt, _
              pt.CacheIndex, _
              pt.SourceData, _
              pt.PivotCache.RecordCount, _
              SDCols, _
              SDHead, _
              strFix, _
              pt.PivotCache.RefreshDate)
        'add hyperlink to pt range
        .Hyperlinks.Add _
            Anchor:=.Cells(RowPL, 4), _
            Address:="", _
            SubAddress:="'" & ws.Name _
                & "'!" & pt.TableRange2.Address, _
            ScreenTip:=pt.TableRange2.Address, _
            TextToDisplay:=pt.TableRange2.Address
      End With

     RowPL = RowPL + 1
   Next pt
Next ws

With wsPL
  .Rows(1).Font.Bold = True
  .Range(.Cells(1, 1), .Cells(1, RptCols)) _
      .EntireColumn.AutoFit
End With

exitHandler:
  Set wsPL = Nothing
  Set ws = Nothing
  Set pt = Nothing
  Exit Sub

End Sub

List Sheets with Multiple Pivot Tables

Use the following macro, named ListWbPTsMulti, to create a list of all the pivot tables in the active workbook, for sheets that have 2 or more pivot tables.

First, the macro counts the sheets that have 2 or more pivot tables.

• If none are found, the macro ends.

If at least one sheet has multiple pivot tables, the macro adds a new sheet to the workbook. On that sheet, the macro creates a list of pivot tables, with the following information:

• Worksheet name
• Number of pivot tables on the sheet
• Pivot Table name
• Number of columns and rows in the pivot table
• Pivot Table address with hyperlink
  • Hyperlink works if sheet is visible
• Pivot Cache index number
• Sheet Visibility – Visible, Hidden, or Very Hidden 

Add this ListWbPTsMulti macro to a regular code module in your workbook.

Sub ListWbPTsMulti()
Dim ws As Worksheet
Dim pt As PivotTable
Dim ptTR2 As Range
Dim wsPL As Worksheet
Dim r As Long
Dim ptAddr As String
Dim lWks As Long
Dim lPTs As Long
Dim lColsPT As Long
Dim lColHL As Long
Dim lRowsPT As Long
Dim lCols As Long
Dim strHid As String
On Error Resume Next

'check for multi pt sheets
For Each ws In ActiveWorkbook.Worksheets
  If ws.PivotTables.Count > 1 Then
    lWks = lWks + 1
  End If
Next ws

If lWks = 0 Then
  MsgBox "No sheets have multiple pivot tables"
  GoTo exitHandler
End If

Application.EnableEvents = False

Set wsPL = Worksheets.Add
lCols = 8
lColHL = 6 'column with hyperlink

wsPL.Range(wsPL.Cells(1, 1), _
      wsPL.Cells(1, lCols)).Value = _
    Array("Worksheet", "PTs", _
      "PT Name", "PT Cols", _
      "PT Rows", "Address", "Cache", "Hidden")
r = 2

For Each ws In ActiveWorkbook.Worksheets
  lPTs = ws.PivotTables.Count
  If lPTs > 1 Then
    Select Case ws.Visible
    Case -1: strHid = "Visible"
    Case 0: strHid = "Hidden"
    Case 2: strHid = "Very Hidden"
  End Select

   For Each pt In ws.PivotTables
   Set ptTR2 = pt.TableRange2
   ptAddr = Replace(ptTR2.Address, "$", "")
     
    lColsPT = pt.TableRange2.Columns.Count
    lRowsPT = pt.TableRange2.Rows.Count
     
     wsPL.Range(wsPL.Cells(r, 1), _
      wsPL.Cells(r, lCols)).Value = _
        Array(ws.Name, lPTs, _
          pt.Name, lColsPT, lRowsPT, _
          ptAddr, pt.CacheIndex, strHid)
        'add hyperlink to pt address
        wsPL.Hyperlinks.Add _
            Anchor:=wsPL.Cells(r, lColHL), _
            Address:="", _
            SubAddress:="'" & ws.Name & "'!" _
                & ptAddr, _
            ScreenTip:=pt.Name, _
            TextToDisplay:=ptAddr
     r = r + 1
   Next pt
  End If
Next ws

With wsPL
  .Tab.ColorIndex = 16777215  'white
  .Rows(1).EntireRow.Font.Bold = True
  .Cells(1, 1).CurrentRegion.EntireColumn.AutoFit

  .ListObjects.Add(xlSrcRange, _
    .Cells(1, 1).CurrentRegion, , xlYes) _
      .Name = ""
End With

exitHandler:
  Set pt = Nothing
  Set ptTR2 = Nothing
  Set ws = Nothing
  Set wsPL = Nothing
  Application.EnableEvents = True
  Exit Sub

errHandler:
  GoTo exitHandler
End Sub

Get the Workbook

To see how the macros work, and to get the sample code, get the Pivot Table List Macros workbook. The zipped file is in xlsm format, and contains macros. Enable macros when you open the workbook, if you want to test the macros.

More Tutorials

Pivot Table Field List Macros

Pivot Table Errors

Pivot Cache Macros