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
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:
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
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:
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:
or
This video shows how the macro helps with trouble shooting, and there are written details below the video.
The code checks each worksheet, and for each pivot table on that sheet, it lists the following information:
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:
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
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 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:
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
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.
Last updated: April 28, 2022 3:56 PM