Home > Pivot > Macros > Pivot Cache
Excel Pivot Cache Macros
These Excel macros will help you work with a pivot cache - a special memory area where pivot table records are saved. For example, create a list of all pivot caches in a workbook, refresh all pivot caches, or show the count of records in a pivot cache

|
Show Pivot Table's CacheIndex
You can display a pivot table's CacheIndex number by using the following
User Defined Function. Store the function code in a worksheet module.
Then, on the worksheet, enter the formula:
=ShowCacheIndex(B5)
replacing B5 with a cell in your pivot table. 

Function ShowCacheIndex(rngPT As Range) As Long
ShowCacheIndex = rngPT.PivotTable.CacheIndex
End Function
|
Show Pivot Cache Memory Used
You can display the memory used by a pivot cache, by using the following
User Defined Function. Store the function code in a worksheet module.
Then, on the worksheet, enter the formula:
=GetMemory(B5)/1000
replacing B5 with a cell in your pivot table. The result is displayed
in kilobytes. 

Function GetMemory(rngPT As Range) As Long
'pivot table tutorial by contextures.com
Dim pt As PivotTable
Set pt = rngPT.PivotTable
GetMemory = ActiveWorkbook _
.PivotCaches(pt.CacheIndex).MemoryUsed
End Function
|
Show the Pivot Cache Count
You can display the number of pivot caches in the active workbook,
by using the following macro. Store the code in a regular code module.
The macro shows a message box, with the pivot cache count

Sub CountCaches()
MsgBox "There are " _
& ActiveWorkbook.PivotCaches.Count _
& " pivot caches in the active workook."
End Sub
|
Show the Pivot Cache Record Count
You can display the number of records in a pivot cache, by using
the following User Defined Function. Store the function code in a
worksheet module. Then, on the worksheet, enter the formula:
=GetRecords(B5)
replacing B5 with a cell in your pivot table. 

Function GetRecords(rngPT As Range) As Long
'pivot table tutorial by contextures.com
Dim pt As PivotTable
Set pt = rngPT.PivotTable
GetRecords = ActiveWorkbook _
.PivotCaches(pt.CacheIndex).RecordCount
End Function
|
Change the Pivot Cache
If you have created several Pivot Tables in a workbook, you may find
it more efficient to use the same pivot cache for all the Pivot Tables.
The following code will change the pivot cache for each pivot table
in the workbook. 
Sub ChangePivotCache()
'pivot table tutorial by contextures.com
'change pivot cache for all Pivot Tables in workbook
Dim pt As PivotTable
Dim wks As Worksheet
For Each wks In ActiveWorkbook.Worksheets
For Each pt In wks.PivotTables
pt.CacheIndex = Sheets("Pivot").PivotTables(1).CacheIndex
Next pt
Next wks
End Sub
|
Create Pivot Table From Cache
Use the following code to create a new pivot table from an existing pivot cache. There are two macro examples below.
- The first pivot cache is used
- The pivot cache for first pivot table on a specific worksheet is used
NOTE: The macros don't give the pivot tables a name, so Excel automatically creates a numbered name for each pivot table, such as PivotTable1.
Macro 1: The first pivot cache is used -- wb.PivotCaches(1)
Sub CreatePivotFromCacheNumber()
Dim wb As Workbook
Dim wsNew As Worksheet
Dim pc As PivotCache
Dim ptNew As PivotTable
Set wb = ActiveWorkbook
Set pc = wb.PivotCaches(1)
Set wsNew = Sheets.Add
Set ptNew = pc.CreatePivotTable(wsNew.Range("A3"))
End Sub
Macro 2: The pivot cache for first pivot table on a specific worksheet is used
Sub CreatePivotFromPTCache()
Dim wb As Workbook
Dim wsNew As Worksheet
Dim pc As PivotCache
Dim ptNew As PivotTable
Set wb = ActiveWorkbook
Set pc = wb.Sheets("PivotReg") _
.PivotTables(1).PivotCache
Set wsNew = Sheets.Add
Set ptNew = pc.CreatePivotTable _
(wsNew.Range("A3"))
End Sub
|
Create New Cache for Selected Pivot
Table
If two or more pivot tables are based on the same pivot cache, they
will share some features, such as calculated items and grouped fields.
To create a separate pivot cache for a pivot table, select
a cell in the pivot table, and then run the following code.
The code adds a sheet to the workbook, and creates a new pivot table
there, based on the same data source, but in a new pivot cache.
The selected pivot table is set to the same pivot cache as the new
table, and then the temporary sheet is deleted.
Sub SelPTNewCache()
Dim wsTemp As Worksheet
Dim pt As PivotTable
On Error Resume Next
Set pt = ActiveCell.PivotTable
If pt Is Nothing Then
MsgBox "Active cell is not in a pivot table"
Else
Set wsTemp = Worksheets.Add
ActiveWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=pt.SourceData).CreatePivotTable _
TableDestination:=wsTemp.Range("A3"), _
TableName:="PivotTableTemp"
pt.CacheIndex = wsTemp.PivotTables(1).CacheIndex
Application.DisplayAlerts = False
wsTemp.Delete
Application.DisplayAlerts = True
End If
exitHandler:
Set pt = Nothing
End Sub
|
Remove Duplicate Pivot Caches
Multiple pivot tables in a workbook may be based on the same data
source, but use different pivot caches. This macro creates a list
of pivot caches, checks for duplicate data sources, and eliminates
duplicate caches.
WARNING: Test this on a copy of your workbook, to ensure that it
will work as expected with your data.
Sub CheckCaches()
' Developed by Contextures Inc.
' www.contextures.com
Dim pc As PivotCache
Dim wsList As Worksheet
Dim lRow As Long
Dim lRowPC As Long
Dim pt As PivotTable
Dim ws As Worksheet
Dim lStart As Long
lStart = 2
lRow = lStart
Set wsList = Worksheets.Add
For Each pc In ActiveWorkbook.PivotCaches
wsList.Cells(lRow, 1).Value = pc.Index
wsList.Cells(lRow, 2).Value = pc.SourceData
wsList.Cells(lRow, 3).FormulaR1C1 = _
"=INDEX(R1C[-2]:R[-1]C[-2],MATCH(RC[-1],R1C[-1]:R[-1]C[-1],0))"
lRow = lRow + 1
Next pc
For lRowPC = lRow - 1 To lStart Step -1
With wsList.Cells(lRowPC, 3)
If IsNumeric(.Value) Then
For Each ws In ActiveWorkbook.Worksheets
Debug.Print ws.Name
For Each pt In ws.PivotTables
Debug.Print .Offset(0, -2).Value
If pt.CacheIndex = .Offset(0, -2).Value Then
pt.CacheIndex = .Value
End If
Next pt
Next ws
End If
End With
Next lRowPC
'uncomment lines below to delete the temp worksheet
'Application.DisplayAlerts = False
'wsList.Delete
exitHandler:
Application.DisplayAlerts = True
Exit Sub
errHandler:
MsgBox "Could not change all pivot caches"
Resume exitHandler
End Sub
|
List All Pivot Caches
Run this macro to list all the pivot caches in the active workbook. It adds a new sheet to the workbook, with a list of pivot caches, with the following details:
- Cache Index Number
- Number of Pivot Tables using the cache
- Number of records in the cache
- Source Type (xldatabase or Other Source)
- Data Source (table name or sheet name and address
- Latest Refresh date and time
- Is the pivot cache set to refresh on open?

Add the following code to a regular worksheet module, then run the macro to create the list.
|
Sub ListAllPivotCaches()
' Developed by www.contextures.com
' list all pivot caches in active workbook
Dim pc As PivotCache
Dim wb As Workbook
Dim ws As Worksheet
Dim lRow As Long
Dim wsAll As Worksheet
Dim lPC As Long
Dim lPCs As Long
Dim lFields As Long
Dim lColDate As Long
Dim ptAll As PivotTable
Dim strSource As String
Dim strST As String
Dim rngS As Range
Dim strSourceR1C1 As String
On Error Resume Next
Application.EnableEvents = False
lRow = 1
lFields = 7
lColDate = 6
Set wb = ActiveWorkbook
lPCs = wb.PivotCaches.Count
If lPCs = 0 Then
MsgBox "No pivot caches in the workbook"
Exit Sub
End If
Set ws = Worksheets.Add
With ws
.Range(.Cells(1, 1), .Cells(1, lFields)) _
.Value = Array("Cache Index", _
"PTs", _
"Records", _
"Source Type", _
"Data Source", _
"Refresh DateTime", _
"Refresh Open")
End With
lRow = lRow + 1
For Each pc In wb.PivotCaches
'count the pivot tables
lPC = 0
Select Case pc.SourceType
Case 1
strSourceR1C1 = pc.SourceData
strSource = Application.ConvertFormula("=" & _
strSourceR1C1, xlR1C1, xlA1)
strSource = Replace(strSource, "[" & wb.Name & "]", "")
strSource = Right(strSource, Len(strSource) - 1)
strST = "xlDatabase"
Case Else
strSource = "N/A"
strST = "Other Source"
End Select
For Each wsAll In wb.Worksheets
For Each ptAll In wsAll.PivotTables
If ptAll.CacheIndex = pc.Index Then
lPC = lPC + 1
End If
Next ptAll
Next wsAll
With ws
On Error Resume Next
ws.Range(ws.Cells(lRow, 1), _
ws.Cells(lRow, lFields)).Value = _
Array(pc.Index, _
lPC, _
pc.RecordCount, _
strST, _
strSource, _
pc.RefreshDate, _
pc.RefreshOnFileOpen)
End With
lRow = lRow + 1
Next pc
With ws
With .Range(.Cells(1, 1), .Cells(1, lFields))
.EntireRow.Font.Bold = True
.EntireColumn.AutoFit
End With
.Columns(lColDate).NumberFormat _
= "[$-409]dd-mmm-yyyy h:mm AM/PM;@"
End With
Application.EnableEvents = True
End Sub
Refresh All Pivot Caches
This macro tries to refresh all the pivot caches in the active workbook. If unable to refresh a pivot cache, a message shows the cache's index number, and the error description.

At the end of the macro, a message shows the count of pivot caches, and the count of failed refreshes.

NOTE: This macro temporarily turns off calculation for the 2 worksheets that have formulas with User Defined Functions, such as the GetMemory function in the screen shot below.
If calculation is not turned off, those functions will run automatically, and cause errors.

RefreshAllPivotCaches Macro Code
Copy the code below to a regular code module.
|
Sub RefreshAllPivotCaches()
' Developed by Contextures Inc.
' www.contextures.com
Dim wb As Workbook
Dim lPCs As Long
Dim lPC As Long
Dim lProb As Long
Application.EnableEvents = False
On Error Resume Next
'turn off calc on sheets with UDF formulas
Sheets("PivotRep").EnableCalculation = False
Sheets("PivotProd").EnableCalculation = False
Set wb = ActiveWorkbook
lPCs = wb.PivotCaches.Count
For lPC = 1 To lPCs
wb.PivotCaches(lPC).Refresh
If Err.Number <> 0 Then
MsgBox "Could not refresh pivot cache " & lPC _
& vbCrLf _
& "Error: " _
& vbCrLf _
& Err.Description
Err.Clear
lProb = lProb + 1
End If
Next lPC
MsgBox "Refresh is complete. " _
& vbCrLf _
& "Pivot Cache Count: " & lPCs _
& vbCrLf _
& "Failed refreshes: " & lProb
'turn on calc on sheets with UDF formulas
Sheets("PivotRep").EnableCalculation = True
Sheets("PivotProd").EnableCalculation = True
Application.EnableEvents = True
End Sub