Excel VBA to create new PivotCache and connect multiple Pivot Tables

I have a workbook with many pivot tables that are based on a range that is deleted and refreshed using VBA. Currently, to update the data source, as the last part of that sub routine, I recreate PivotCaches for each PivotTable and refresh.

I want just 6 of the tables to be linked together with one common PivotCache so they can share slicers etc and I cannot get it working.

I have looked all over for a solution to this but I keep coming up short and I have been stuck on it for a fair while now. I am reasonably new to VBA but I can usually work it out with trial and error but this one just has me stumped.

I obviously have done something wrong and any help to identify what, would be greatly appreciated.

Thanks :)

My current code is below (Note: I removed the non-related stuff from the code for ease of reading):

Sub RunReport()


On Error GoTo ErrorHandler

'##############         Define Variables        ##############


    Dim WS_O As Worksheet           'Output sheet - report sheet
    Dim WS_P As Worksheet           'Pivot table Sheet
    Dim OuputRow As Integer         'First row for output of data
    Dim LastRow_O As Integer        'Last used row of output sheet
    Dim PivotCacheName As PivotCache
    Dim PivotRange As String        'Range of data for Pivot Data Source
    Dim PivotName1 As String        'Pivot Table Name Strings
    Dim PivotName2 As String
    Dim PivotName3 As String
    Dim PivotName4 As String
    Dim PivotName5 As String
    Dim PivotName6 As String
    


'##############   Modify Application Settings   ##############

'Store current configuration

    OriginalCalcMode = Application.Calculation
    
'Set configuration for fastest processing

    Application.Calculation = xlManual
    Application.ScreenUpdating = False
    Application.EnableEvents = False


'##############       Set Variable Values       ##############


'Worksheets

    Set WS_O = Sheets("Report")                             'Output sheet - report sheet
    Set WS_P = Sheets("Pivot Tables - Live Data")           'Pivot tables sheet
    
    
'Pivot Tables

    PivotName1 = "PivotTable1"
    PivotName2 = "PivotTable2"
    PivotName3 = "PivotTable3"
    PivotName4 = "PivotTable4"
    PivotName5 = "PivotTable5"
    PivotName6 = "PivotTable6"
    
    
'General

    OutputRow = 7
    
    
'Used Ranges

    LastRow_O = WS_O.Range("A" & Rows.Count).End(xlUp).Row

 
    
 '##############     Refresh Pivot Tables        ##############


'Define Data Range

    PivotRange = WS_O.Name & "!" & "A" & OutputRow - 1 & ":AM" & LastRow_O


'Error Handling
  
    'Make sure every column in data set has a heading and is not blank
    If WorksheetFunction.CountBlank(WS_O.Range("A" & OutputRow - 1 & ":AM" & LastRow_O).Rows(1)) > 0 Then
        MsgBox "One or more columns in ''Report'' sheet has a blank heading;" & vbNewLine _
        & "This has prevented the pivot tables from refreshing correctly." & vbNewLine & vbNewLine _
        & "Please verify cells A" & OutputRow - 1 & ":AM" & OutputRow - 1 & " in ''Report'' sheet are not blank and try again.", vbCritical, "ERROR - Column Heading Missing"
        GoTo EndSub
    End If


'Change Pivot Data Sources to a single cache

    Set PivotCacheName = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PivotRange, Version:=xlPivotTableVersion15)

    WS_P.PivotTables(PivotName1).ChangePivotCache (PivotCacheName)
    WS_P.PivotTables(PivotName2).ChangePivotCache (PivotCacheName)
    WS_P.PivotTables(PivotName3).ChangePivotCache (PivotCacheName)
    WS_P.PivotTables(PivotName4).ChangePivotCache (PivotCacheName)
    WS_P.PivotTables(PivotName5).ChangePivotCache (PivotCacheName)
    WS_P.PivotTables(PivotName6).ChangePivotCache (PivotCacheName)


'Refresh Pivot Tables

    'Turn on auto calc while pivot's update
    Application.Calculation = xlCalculationAutomatic


    WS_P.PivotTables(PivotName1).RefreshTable
    WS_P.PivotTables(PivotName2).RefreshTable
    WS_P.PivotTables(PivotName3).RefreshTable
    WS_P.PivotTables(PivotName4).RefreshTable
    WS_P.PivotTables(PivotName5).RefreshTable
    WS_P.PivotTables(PivotName6).RefreshTable


   
'Completion Confirmation
  
        MsgBox "Report data has been compiled and pivot tables have been successfully refreshed.", vbInformation, "SUCCESS! - Report Compilation Complete"

    
'##############   End Sub and Reset Application Configuration   ##############


'Standard End Sub Functionality (where no undocumented error occurred)

EndSub:
        Application.ScreenUpdating = False
        Application.Calculation = OriginalCalcMode   'Reset calc option to what it was previously
        Application.EnableEvents = True
    Exit Sub


'Error Handling (where an undocumented error occurred - that is, an error without an explainatory message box)

ErrorHandler:
    Application.ScreenUpdating = False
'    Application.Calculation = OriginalCalcMode
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    
     MsgBox "An error caused this subroutine to stop working correctly." & vbNewLine _
        & "Contact Administrator for assistance.", vbCritical, "ERROR - Contact Administrator"
       
    
End Sub

I was previously using this and still am for some tables I don't want using the same PivotCache:

'Create new caches for each table

    WS_P.PivotTables(PivotName1).ChangePivotCache _
        ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PivotRange)
        
    WS_P.PivotTables(PivotName2).ChangePivotCache _
        ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PivotRange)
        
    WS_P.PivotTables(PivotName3).ChangePivotCache _
        ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PivotRange)
        
    WS_P.PivotTables(PivotName4).ChangePivotCache _
        ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PivotRange)
        
    WS_P.PivotTables(PivotName5).ChangePivotCache _
        ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PivotRange)
         
    WS_P.PivotTables(PivotName6).ChangePivotCache _
        ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PivotRange)

I'm currently getting the Runtime 438 Error (Object doesn't support this property or method) here >>>

    WS_P.PivotTables(PivotName1).ChangePivotCache (PivotCacheName)

EDIT: I have found a solution and added an answer below.

Solution

So, after a good nights sleep and several more hours of research, I have what I believe to be a solution.

It's probably not the best way, but it works and hasn't yet caused me any issues...

'Create New Pivot Cache from Data Range
    WS_P.PivotTables(PivotName1).ChangePivotCache _
        ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PivotRange)
  
'Link Other Pivot Tables to same Pivot Cache     
  
    WS_P.PivotTables(PivotName2).CacheIndex = WS_P.PivotTables(PivotName1).CacheIndex
    WS_P.PivotTables(PivotName3).CacheIndex = WS_P.PivotTables(PivotName1).CacheIndex
    WS_P.PivotTables(PivotName4).CacheIndex = WS_P.PivotTables(PivotName1).CacheIndex
    WS_P.PivotTables(PivotName5).CacheIndex = WS_P.PivotTables(PivotName1).CacheIndex
    WS_P.PivotTables(PivotName6).CacheIndex = WS_P.PivotTables(PivotName1).CacheIndex

I'm still not sure why the other way wasn't working so would still appreciate some feedback, if anyone has any as this method does prohibit me attaching slicers to all pivot tables (I have to leave the first one out).