Unable to reconnect slicers after disconnecting and changing data sources

[rongheng]

Hi,

I have many pivot tables & slicers on different sheets of my excel workbook. The file is constantly being updated(new/changing tables) by many people so my script has to update the data and all the data sources in all the pivot tables.
The objective is to:
1. Dynamically identify the slicers connected to the pivot tables
2. Disconnect the slicers from the pivot tables
3. Update all the data sources
4. Refresh all the pivot tables
5. Reconnect the slicers to the pivot tables like it originally was identified in step 1

I found the code to disconnect and reconnect the slicers but I am encountering the error "Run-time error '1004' Application-defined or object-defined error" when trying to reconnect the slicers.

'Disconnect all pivot table slicers
Dim SlicersDict As Variant
Dim PTDict As Variant
Set SlicersDict = CreateObject("Scripting.Dictionary")
Dim sl As SlicerCache, slpt As PivotTable, SlItem As Variant, pvtbl As Variant, i As Byte
'create a dictionary of dictionaries with slicers and connected pivot tables
For Each sl In ThisWorkbook.SlicerCaches
    Set PTDict = CreateObject("Scripting.Dictionary")
    For Each slpt In sl.PivotTables
        PTDict.Add Key:=slpt.Parent.Name & slpt.Name, Item:=slpt
    Next
    SlicersDict.Add Key:=sl.Name, Item:=PTDict
Next
 
For Each SlItem In SlicersDict.Keys
   'remove pvtbl connections for this slicer
    Set PTDict = SlicersDict(SlItem)
    pvtbl = PTDict.items
    If UBound(pvtbl) >= LBound(pvtbl) Then
        For i = LBound(pvtbl) To UBound(pvtbl)
            pvtbl(i).SaveData = True
            ThisWorkbook.SlicerCaches(SlItem).PivotTables.RemovePivotTable (pvtbl(i))
        Next
    End If
Next

'Update all pivot table data source
For Each wsPT In wb1.Sheets
    If wsPT.PivotTables.Count > 0 Then
        For Each pvtbl In wsPT.PivotTables
             pvtbl.ChangePivotCache wb1.PivotCaches.Create(SourceType:=xlDatabase, SourceData:="data_range")
        Next
    End If
Next

'Refresh all pivot tables
ActiveWorkbook.RefreshAll

'Reconnect all pivot table slicers
For Each SlItem In SlicersDict.Keys
    Set PTDict = SlicersDict(SlItem)
    pvtbl = PTDict.items

    'reconnect all pivot tables to this slicer
    If UBound(pvtbl) >= 0 Then
        For i = LBound(pvtbl) To UBound(pvtbl)
            ThisWorkbook.SlicerCaches(SlItem).PivotTables.AddPivotTable (pvtbl(i))
        Next
    End If
Next
Set SlicersDict = Nothing
Set PTDict = Nothing

The error is on this line:

ThisWorkbook.SlicerCaches(SlItem).PivotTables.AddPivotTable (pvtbl(i))

I did much reading and I think it has something to do with attaching slicers created from one Pivot Cache to Pivot Tables associated with another not being possible.
However, I still cannot figure it out. Would appreciate if anyone can help me out.

 

[andresleonsalas]

Any solution for this? I have EXACTLY the same problem

 

[Domenic]

I think it's because you're creating a new pivot cache for each pivot table, instead of creating a single pivot cache and assigning the same one to each pivot table. Try the following code to update the source data for each pivot table . . .

Dim bCacheCreated As Boolean
Dim lCacheIndex As Long

'Update all pivot table data source
bCacheCreated = False
For Each wsPT In wb1.Sheets
    For Each pvtbl In wsPT.PivotTables
        With pvtbl
            If Not bCacheCreated Then
                .ChangePivotCache wb1.PivotCaches.Create(SourceType:=xlDatabase, SourceData:="data_range")
                lCacheIndex = .cacheIndex
                bCacheCreated = True
            Else
                .cacheIndex = lCacheIndex
            End If
        End With
    Next pvtbl
Next wsPT

However, here's another way to do the same thing. Note that it uses a collection of arrays to store the slicer cache and connected pivot tables. And, it only creates a single pivot cache, and then assigns it to each pivot table.

Option Explicit

Sub ChangeSourceDataForAllPivotTables()

    Dim colConnections As Collection
    Dim objSlicerCache As SlicerCache
    Dim objPivotTable As PivotTable
    Dim wksCurrent As Worksheet
    Dim lngCacheIndex As Long
    Dim blnCacheCreated As Boolean
    Dim itm As Variant
   
    'create a collection to store slicer caches and connected pivot tables
    Set colConnections = New Collection
   
    'add each slicer cache and connected pivot tables to collection, and remove pivot table from slicer cache
    For Each objSlicerCache In ThisWorkbook.SlicerCaches
        For Each objPivotTable In objSlicerCache.PivotTables
            colConnections.Add Array(objSlicerCache, objPivotTable)
            objSlicerCache.PivotTables.RemovePivotTable objPivotTable
        Next objPivotTable
    Next objSlicerCache
   
    'update the source data for all pivot tables
    blnCacheCreated = False
    For Each wksCurrent In ThisWorkbook.Worksheets
        For Each objPivotTable In wksCurrent.PivotTables
            With objPivotTable
                If Not blnCacheCreated Then
                    .ChangePivotCache ThisWorkbook.PivotCaches.Create(xlDatabase, Worksheets("New Data").Range("a1").CurrentRegion)
                    .RefreshTable
                    lngCacheIndex = .cacheIndex
                    blnCacheCreated = True
                Else
                    .cacheIndex = lngCacheIndex
                End If
            End With
        Next objPivotTable
    Next wksCurrent
   
    'add pivot tables to slicer caches
    For Each itm In colConnections
        itm(0).PivotTables.AddPivotTable itm(1)
    Next itm
   
    Set colConnections = Nothing
   
End Sub

Hope this helps!