Option Explicit
Option Base 1
Sub PivotReport()
Dim pc As PivotCache
Dim pt As PivotTable
Dim lngPivots As Long
Dim lngPosition As Long
Dim wks As Worksheet
Dim varSettings As Variant
Dim bWorksheetExists As Boolean
Dim wksOutput As Worksheet
Dim rngOutput As Range
Dim loOutput As ListObject
' The purpose of lngPosition? I don't want to hard-code the array position of each element at this early development stage.
' So I just increment a counter, which means I can move these headings around, and as long as the correstponding
' code that records the actual attributes is in the same order, I don't have to renumber the array elements
' any time I make a change.
lngPosition = 1
ReDim varSettings(14, 1)
varSettings(lngPosition, 1) = "Pivot Name"
lngPosition = lngPosition + 1
varSettings(lngPosition, 1) = "Worksheet"
lngPosition = lngPosition + 1
varSettings(lngPosition, 1) = "Worksheet Protected?"
lngPosition = lngPosition + 1
varSettings(lngPosition, 1) = "CacheIndex"
lngPosition = lngPosition + 1
varSettings(lngPosition, 1) = "Pivot Address"
lngPosition = lngPosition + 1
varSettings(lngPosition, 1) = "RowGrand"
lngPosition = lngPosition + 1
varSettings(lngPosition, 1) = "ColumnGrand"
lngPosition = lngPosition + 1
varSettings(lngPosition, 1) = "MissingItemsLimit"
lngPosition = lngPosition + 1
varSettings(lngPosition, 1) = "RecordCount"
lngPosition = lngPosition + 1
varSettings(lngPosition, 1) = "MemoryUsed (kB)"
lngPosition = lngPosition + 1
varSettings(lngPosition, 1) = "SaveData"
lngPosition = lngPosition + 1
varSettings(lngPosition, 1) = "EnableRefresh"
lngPosition = lngPosition + 1
varSettings(lngPosition, 1) = "SourceData"
lngPosition = lngPosition + 1
varSettings(lngPosition, 1) = "EnableDrilldown"
lngPosition = lngPosition + 1
lngPivots = 1
For Each wks In ActiveWorkbook.Worksheets
For Each pt In wks.PivotTables
lngPosition = 1
lngPivots = lngPivots + 1
ReDim Preserve varSettings(14, lngPivots)
With pt
varSettings(lngPosition, lngPivots) = .Name
lngPosition = lngPosition + 1
varSettings(lngPosition, lngPivots) = wks.Name
lngPosition = lngPosition + 1
varSettings(lngPosition, lngPivots) = wks.ProtectContents
lngPosition = lngPosition + 1
varSettings(lngPosition, lngPivots) = .CacheIndex
lngPosition = lngPosition + 1
varSettings(lngPosition, lngPivots) = .TableRange2.Address
lngPosition = lngPosition + 1
varSettings(lngPosition, lngPivots) = .RowGrand
lngPosition = lngPosition + 1
varSettings(lngPosition, lngPivots) = .ColumnGrand
lngPosition = lngPosition + 1
varSettings(lngPosition, lngPivots) = .PivotCache.MissingItemsLimit
lngPosition = lngPosition + 1
varSettings(lngPosition, lngPivots) = .PivotCache.RecordCount
lngPosition = lngPosition + 1
varSettings(lngPosition, lngPivots) = .PivotCache.MemoryUsed / 1000
lngPosition = lngPosition + 1
varSettings(lngPosition, lngPivots) = .SaveData
lngPosition = lngPosition + 1
varSettings(lngPosition, lngPivots) = .PivotCache.EnableRefresh
lngPosition = lngPosition + 1
varSettings(lngPosition, lngPivots) = .SourceData
lngPosition = lngPosition + 1
varSettings(lngPosition, lngPivots) = .EnableDrilldown
lngPosition = lngPosition + 1
End With
Next pt
Next wks
'Create a worksheet to dump the output into
Set wksOutput = Sheets.Add
Set rngOutput = Range("A1").Resize(UBound(varSettings, 2), UBound(varSettings, 1))
rngOutput.Value = Application.Transpose(varSettings)
Set loOutput = wksOutput.ListObjects.Add(xlSrcRange, rngOutput, , xlYes)
End Sub