VBA Excel file size containing multiple pivot tables is huge

Question

I am automating the process of creating pivot tables in excel. The problem I have is that the pivot tables I create using my macro is way larger than the ones I create manually. Both of the pivot tables look identical but there is a great difference in file size.

As seen in the image above, the one created by my macro is about 6 times larger! I suspect that it is the way I cache for the data when creating my pivot tables. So, here is the general code I use to create my pivot tables.

Sub pivottable1()

    Dim PSheet As Worksheet, DSheet As Worksheet
    Dim PCache As PivotCache
    Dim PTable As PivotTable
    Dim PField As PivotField
    Dim PRange As Range
    Dim LastRow As Long
    Dim LastCol As Long
    Dim PvtTable As PivotTable
    Dim SheetName As String
    Dim PTName As String

    SheetName = "MySheetName1"
    PTName = "PivotTable1"
    On Error Resume Next
    Application.DisplayAlerts = False
    Worksheets(SheetName).Delete
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Name = SheetName
    Application.DisplayAlerts = True

    Set PSheet = Worksheets(SheetName)
    Set DSheet = Worksheets(1)

    LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
    LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column
    Set PRange = DSheet.Cells(1, 1).Resize(LastRow, LastCol)

    Set PCache = ActiveWorkbook.PivotCaches.Create _
    (SourceType:=xlDatabase, SourceData:=PRange). _
    CreatePivotTable(TableDestination:=PSheet.Cells(4, 1), _
    TABLENAME:=PTName)

    Set PTable = PCache.CreatePivotTable _
    (TableDestination:=PSheet.Cells(1, 1), TABLENAME:=PTName)

    Sheets(SheetName).Select
        Set PvtTable = ActiveSheet.PivotTables(PTName)
        'Rows
        With PvtTable.PivotFields("TypeCol")
            .Orientation = xlRowField
            .Position = 1
        End With

        With PvtTable.PivotFields("NameCol")
            .Orientation = xlRowField
            .Position = 2
        End With

        'Columns
        With PvtTable.PivotFields("CategoryCol")
            .Orientation = xlColumnField
            .Position = 1
        End With

        'Values
        PvtTable.AddDataField PvtTable.PivotFields("Values1"), "Value Balance", xlSum
        PvtTable.AddDataField PvtTable.PivotFields("Values2"), "Value 2 Count", xlCount

        With PvtTable
            .PivotFields("TypeCol").ShowDetail = False
            .TableRange1.Font.Size = 10
            .ColumnRange.HorizontalAlignment = xlCenter
            .ColumnRange.VerticalAlignment = xlTop
            .ColumnRange.WrapText = True
            .ColumnRange.Columns.AutoFit
            .ColumnRange.EntireRow.AutoFit
            .RowAxisLayout xlTabularRow
            .ShowTableStyleRowStripes = True
            .PivotFields("TypeCol").AutoSort xlDescending, "Value Balance" 'Sort descdending order
            .PivotFields("NameCol").AutoSort xlDescending, "Value Balance"
        End With

        'Change Data field (Values) number format to have thousand seperator and 0 decimal places.
        For Each PField In PvtTable.DataFields
            PField.NumberFormat = "#,##0"
        Next PField

End Sub

This is how I create 6 different pivot tables which all uses the same source of data which is located in the same workbook and is in the first worksheet of that workbook. So, for example my second pivot table macro code would look something like this.

Sub pivottable2()

    Dim PSheet As Worksheet, DSheet As Worksheet
    Dim PCache As PivotCache
    Dim PTable As PivotTable
    Dim PField As PivotField
    Dim PRange As Range
    Dim LastRow As Long
    Dim LastCol As Long
    Dim PvtTable As PivotTable
    Dim SheetName As String
    Dim PTName As String

    SheetName = "MySheetName2"
    PTName = "PivotTable2"
    On Error Resume Next
    Application.DisplayAlerts = False
    Worksheets(SheetName).Delete
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Name = SheetName
    Application.DisplayAlerts = True

    Set PSheet = Worksheets(SheetName)
    Set DSheet = Worksheets(1)

    LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
    LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column
    Set PRange = DSheet.Cells(1, 1).Resize(LastRow, LastCol)

    Set PCache = ActiveWorkbook.PivotCaches.Create _
    (SourceType:=xlDatabase, SourceData:=PRange). _
    CreatePivotTable(TableDestination:=PSheet.Cells(4, 1), _
    TABLENAME:=PTName)

    Set PTable = PCache.CreatePivotTable _
    (TableDestination:=PSheet.Cells(1, 1), TABLENAME:=PTName)

    Sheets(SheetName).Select
        Set PvtTable = ActiveSheet.PivotTables(PTName)
        'Rows
        With PvtTable.PivotFields("ManagerCol")
            .Orientation = xlRowField
            .Position = 1
        End With

        With PvtTable.PivotFields("IDCol")
            .Orientation = xlRowField
            .Position = 2
        End With

        'Columns
        With PvtTable.PivotFields("CategoryCol")
            .Orientation = xlColumnField
            .Position = 1
        End With

        'Values
        PvtTable.AddDataField PvtTable.PivotFields("Values1"), "Value Balance", xlSum

End Sub

All that I change would be the macro name, the worksheet name, the pivot table name and the input rows/columns/data values for the pivot table.

What I hope to accomplish is to reduce the file size of my macro created pivot tables, to something similar of the ones I create manually.

If there is anything extra that you guys would like to know, please comment. I will make an edit with the question and add the details respectively.

Answer 1

You can use the same pivotcache for multiple pivottables (assuming they're based on the same source data).

Untested:

'creates and returns a shared pivotcache object
Function GetPivotCache() As PivotCache
    Static pc As PivotCache 'static variables retain their value between calls
    Dim pRange As Range

    If pc Is Nothing Then 'create if not yet created
        Set prRange = Worksheets(1).Range("A1").CurrentRegion
        Set pc = ActiveWorkbook.PivotCaches.Create _
                     (SourceType:=xlDatabase, SourceData:=pRange)
    End If
    Set GetPivotCache = pc
End Function


Sub pivottable1()

    '...
    '...

    Set PSheet = Worksheets(SheetName)

    Set PCache = GetPivotCache() '<<< will be created if needed

    Set PTable = PCache.CreatePivotTable _
                   (TableDestination:=PSheet.Cells(1, 1), TableName:=PTName)

    '...
    '...

End Sub