Lukasz
Lukasz

Reputation: 599

multiple pivottables from the same pivotchache error

I'm getting an error "Application-defined or object-defined error" when trying to add a second pivottable to the same pivotcache. The code runs on a different workbook than the one where the pivottables are created. (Excel 2016)

Public Sub exportFA()

    Dim ExportWbk As Workbook
    Dim sExportPath As String
    Dim sTargetWS As Worksheet
    Dim oFAConn As WorkbookConnection
    Dim pt As PivotTable
    Dim pc As PivotCache


    'connect to an existing excel workbook. It has an excel table that will be the source for pivots.
    Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
    If Application.FileDialog(msoFileDialogOpen).Show = -1 Then
        'copy file path to text box
        sExportPath = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)
    Else
        Exit Sub
    End If
        
    If Trim(sExportPath) = "" Then Exit Sub

    Set ExportWbk = Workbooks.Open(sExportPath, False, False)

    Application.EnableEvents = False
    Application.DisplayAlerts = False
    Set sTargetWS = ExportWbk.Sheets.Add(After:=ExportWbk.Worksheets(ExportWbk.Worksheets.Count))
    sTargetWS.Name = "FinancialAnalysis"

    ThisWorkbook.Activate

    'Create a workbook connection to an excel table
    Set oFAConn = ExportWbk.Connections.Add2( _
        "FA_Connection", "", _
        "WORKSHEET;" & sExportPath _
        , ExportWbk.Name & "!tblCombinedAccounting_FA", 7, True, False)

    'Create the pivot cache to be used by the FA tables
    Set pc = ExportWbk.PivotCaches.Create(SourceType:=xlExternal, SourceData:=oFAConn, Version:=6)

   'Setup first pivot. This works fine.
   Set pt = pc.CreatePivotTable(TableDestination:=ExportWbk.Sheets("FinancialAnalysis").Range("C3"), 
   TableName:="ptFA_1", DefaultVersion:=6)

   Call SetupPivot(pt,1) 'setup the fields of the pivot. This is irrelevant as skipping it and placing the second pivot table somewhere else on the sheet still raises an error

   '!!!!!!this raises the error
   Set pt = pc.CreatePivotTable(TableDestination:=ExportWbk.Sheets("FinancialAnalysis").Range("C" & 
   pt.RowRange.End(xlDown).Row + 10), TableName:="ptFA_2", DefaultVersion:=6)

   ' I also tried a different add method, but I get the same error:
   Set pt = ExportWbk.Sheets("FinancialAnalysis").PivotTables.Add(PivotCache:=pc, TableDestination:=ExportWbk.Sheets("FinancialAnalysis").Range("C100"), TableName:="ptFA_2")

Upvotes: 0

Views: 221

Answers (1)

EEM
EEM

Reputation: 6659

It seems that when adding PivotTables to the Data Model a PivotCache needs to be created for each PivotTable. To test this manually create two PivotTables from the same Table while recording a macro. Ensure to check the box Add this data to the Data Model or Use this workbook's Data Model. You'll see in the recorded macro that in both cases a PivotCache is created, however both PivotTables can be "controlled" by a common Slicer.

Proposed solution: This solution applies to PivotTables to be Added to the Data Model.

Public Sub PivotTables_Add_ToDataModel()
Const kCntNme As String = "Cnt_DataModel"   'Connection Name
Const kConnct As String = "WORKSHEET;#PTH"  'ConnectionString
Const kCmdTxt As String = "#WBK!#TBL"       'CommandText
Dim sPath As String
Dim Wbk As Workbook
Dim Wsh As Worksheet
Dim Cnt As WorkbookConnection
Dim Ptb As PivotTable

    Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
    If Application.FileDialog(msoFileDialogOpen).Show = -1 Then
        sPath = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)
        If Trim(sPath) = vbNullString Then Exit Sub
    Else
        Exit Sub
    End If
    
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    
    Set Wbk = Workbooks.Open(sPath, False, False)
    With Wbk
        
        Set Wsh = .Sheets.Add(After:=.Sheets(.Sheets.Count))
        Wsh.Name = "FinancialAnalysis"
    
        Rem Set DataModel Connection
        On Error Resume Next
        Set Cnt = .Connections(kCntNme)
        On Error GoTo 0
        If Cnt Is Nothing Then
            Set Cnt = .Connections.Add2(kCntNme, kCntNme, Replace(kConnct, "#PTH", sPath), _
                Replace(Replace(kCmdTxt, "#WBK", .Name), "#TBL", "tblCombinedAccounting_FA"), xlCmdExcel, True, False)
        End If
    
        Rem Set 1st PivotTable
        Set Ptb = .PivotCaches.Create(SourceType:=xlExternal, SourceData:=.Connections(kCntNme), Version:=6) _
                    .CreatePivotTable(TableDestination:=Wsh.Range("C3"), TableName:="ptFA_1", DefaultVersion:=6)
        
        Rem Set 2nd PivotTable
        Set Ptb = .PivotCaches.Create(SourceType:=xlExternal, SourceData:=.Connections(kCntNme), Version:=6) _
                    .CreatePivotTable(TableDestination:=Wsh.Range("C100"), TableName:="ptFA_2", DefaultVersion:=6)
    
    End With
    
End Sub

Upvotes: 2

Related Questions