CODEWITHSUNDEEP
vbaexcelpivot-table
Chris
Chris

Reputation: 798

Share PivotCache for PivotTables built with data model

I am just cleaning up my workbook and I have used the following code to consolidate my PivotCaches (I had around 200 prior to the cleaning).

Sub changeCache()
Dim ws As Worksheet
Dim pt As PivotTable
Dim pc As PivotCache
Dim first As Boolean
On Error Resume Next

    For Each ws In ActiveWorkbook.Worksheets
        ws.Activate
        For Each pt In ActiveSheet.PivotTables

            If first = False Then
                Set pc = pt.PivotCache
                first = True
            End If 

            pt.CacheIndex = pc.Index

        Next pt
    Next ws

End Sub

This has reduced my PivotCache count to 33.

Sub CountCaches()
  MsgBox ActiveWorkbook.PivotCaches.Count
End Sub

The reason it is 33 and not 1 is because I have 32 PivotTables that are built with the Data Model.

My question is: Does anyone know how to change PivotTables built with the Data Model to all use the same PivotCache?

EDIT

My secondary question is: Do multiple pivot tables all built on a data model

a) reference a single data model; or

b) each have their own model and therefore 'bloat' the Excel file

EDIT2

On further exploration, it appears that the data model is shared for pivot tables that reference the same data. This can be seen in 'Connections' (found under the 'Data' tab in the ribbon). In theory, this shouldn't 'bloat' the file even though the code ActiveWorkbook.PivotCaches.Count counts each pivot table that shares a connection and falsely(?) indicates multiple caches.

I will however leave the bounty open in case someone can provide a more definitive answer.

Upvotes: 8

Views: 2214

Answers (2)

R3uK
R3uK

Reputation: 14537

I'm not yet really used to Data Model and I can't provide doubtless explainations about this.

But I used that code to clean one of the reporting system I was working on, that might help you to get less PivotCaches : 

Sub Caches_Matches()
Dim Ws1 As Worksheet, _
    Pt1 As PivotTable, _
    Ws2 As Worksheet, _
    Pt2 As PivotTable, _
    PcNb As Integer

PcNb = ActiveWorkbook.PivotCaches.Count
MsgBox "PivotCaches.Count = " & PcNb, vbInformation + vbOKOnly, "Before update"

On Error Resume Next

    For Each Ws1 In ActiveWorkbook.Worksheets
        For Each Pt1 In Ws1.PivotTables
            'fix one pt, loop all of them and set same cache if same source
            For Each Ws2 In ActiveWorkbook.Worksheets
                For Each Pt2 In Ws2.PivotTables
                    If Pt1.SourceData <> Pt2.SourceData Or Pt1.PivotCache = Pt2.PivotCache Or Pt1.Name = Pt2.Name Then
                    Else
                        Pt2.CacheIndex = Pt1.PivotCache.Index
                    End If
                Next Pt2
            Next Ws2
        Next Pt1
    Next Ws1

MsgBox "PivotCaches.Count = " & ActiveWorkbook.PivotCaches.Count & Chr(10) & _
        "Before update = " & PcNb, vbInformation + vbOKOnly, "After update"
End Sub

Upvotes: 1

user3476534
user3476534

Reputation: 220

If I understand your question correctly, you just have to set each pc to the first one. So, the first pass, give the pc some other name such as pcfirst, then For each remaining cache, set pc=pcfirst. Some source information here http://www.contextures.com/xlPivot11.html and here http://www.mrexcel.com/forum/excel-questions/380933-set-multiple-pivot-cache-read-one-cache.html

Upvotes: 2

Related Questions