VBA disconnect/connect slicers in active worksheet

Vidar

Well-known Member
Joined
Jul 19, 2012
Messages
1,254
Hi
Sometimes I need to add an extra column to my pivot table by changing the Data Source.
But Excel prompts me to first disconnect my slicers since I have two or more pivottables
on the same worksheet sharing the same pivotcache.

Tried to use the macro recorder to figure out a way to loop through each slicer
and disconnect every pivottable from the slicer.
I'm not familiar with the pivottable/slicer VBA objects.

Vidar
 
What you're trying to do could be done with code that would store all mapping, change the data source and restore all mapping; however a much simpler approach would be to use a Named Range as the data source. It could be either a Dynamic Named Range or a Static Named Range.

This would allow you to just change the range that the Name RefersTo: then refresh the PivotCache.
All the Pivots will be updated to use the new range without the need to disconnect and reconnect the slicers.

This would also be a better approach for the earlier questions asked by Vidar and rfalch.
 
Upvote 0

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
I believe I understand what you're saying. For my personal case: it's something that I have to do once in about 10 excel files. All the other files already have pivots with a dynamic range and are directed to 'Table3'.

the 'older' files have pivots which have [schaduwblad]!K1:K27 as data source. I'm trying to change that to datasource to Table3 but because of the connected slicers, I have not succeeded so far. (the data source is the same, table3 is actually [schaduwblad]!K1:K27), but using a table was better than using a range with columns I was told).
 
Upvote 0
I understand. I'm wrapping up for the night, but I'll post some code tomorrow that you can use to convert existing pivottables that don't use named ranges to those that do.
 
Upvote 0
Here's some code you can use to remap your PivotTables' to reference Tables or Named Ranges as their data source.

Edit the parts in Red font to match your setup.

Code:
Sub Change_SourceData_Of_MultipleSlicer_Connected_Pivots()
'---changes source data of pivots connected to specified slicers
Dim dicPivotIDs As Object
Dim vSlicers() As Variant, vSlicerList() As Variant, vKey As Variant
Dim PT As PivotTable, PT1 As PivotTable
Dim sPivotID As String, sNewSource As String
Dim iSlicer As Long, iPivot As Long, lItem As Long

'--edit list of slicers. They must share the same PivotCache.
'     they don't need to be connected to the same PivotTables
vSlicerList = Array([B][COLOR="#FF0000"]"Slicer_Field1", "Slicer_Field2", "Slicer_Field3"[/COLOR][/B])

'--edit with range reference to new PivotCache datasource
On Error GoTo ErrHandler
'  example1: reference an existing Named Range with Workbook scope
'sNewSource = "MyPivotData"
'  example2: reference an existing Table (ListObject)
sNewSource = "[COLOR="#FF0000"][B]Table1[/B][/COLOR]"
'  example3: other range reference
'sNewSource = Sheets("Sheet1").Range("A1").CurrentRegion.Address

Set dicPivotIDs = CreateObject("Scripting.Dictionary")
ReDim vSlicers(LBound(vSlicerList) To UBound(vSlicerList))

'--build array of arrays mapping each Slicer's connected PivotTables
For iSlicer = LBound(vSlicerList) To UBound(vSlicerList)
   With ActiveWorkbook.SlicerCaches(vSlicerList(iSlicer)).PivotTables
      If .Count Then
         ReDim vPivots(1 To .Count)
         For iPivot = .Count To 1 Step -1
            Set PT = .Item(iPivot)
            Set vPivots(iPivot) = PT
            .RemovePivotTable (PT)
            '--add unique pivot identifiers to dictionary
            sPivotID = "'" & PT.Parent.Name & "'!" & _
               PT.TableRange1.Cells(1).Address
            If Not dicPivotIDs.Exists(sPivotID) Then
               lItem = lItem + 1
               dicPivotIDs.Add sPivotID, lItem
            End If
         Next iPivot
         vSlicers(iSlicer) = vPivots
      End If
   End With
Next iSlicer

'---change datasource of all pivots
For Each vKey In dicPivotIDs.Keys
   If PT1 Is Nothing Then
      Set PT1 = Range(vKey).PivotTable

      PT1.ChangePivotCache _
            ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
            SourceData:=sNewSource)
   Else
      Range(vKey).PivotTable.CacheIndex = PT1.CacheIndex
   End If
Next vKey

'--reconnect Pivots to Slicers using stored mapping
For iSlicer = LBound(vSlicers) To UBound(vSlicers)
   If Not IsEmpty(vSlicers(iSlicer)) Then
      With ActiveWorkbook.SlicerCaches(vSlicerList(iSlicer)).PivotTables
         For iPivot = LBound(vSlicers(iSlicer)) To UBound(vSlicers(iSlicer))
            .AddPivotTable vSlicers(iSlicer)(iPivot)
         Next iPivot
      End With
   End If
Next iSlicer

MsgBox "The PivotTables' data source have been updated"

Exit Sub
ErrHandler:
   MsgBox Err.Number & ": " & Err.Description
End Sub
 
Upvote 0
Many thanks!
the code works perfectly, however, I received an error 5: invalid procedure call or invalid argument.
I think this error is caused by not having the right table created yet. I have multiple codes running and after i've created the table with the right name, I use the call method to start the code you created. I'm wondering when this code starts, does the call function start the code after or during the code that creates the table?


also, when I use alt+f8 to start the change_slicers sub (the sub you've posted) i get the same error (and tabel3 is created).
 
Upvote 0
One addition to my latest reply: concerning this statement in the code regarding the slicers:
Code:
'--edit list of slicers. They must share the same PivotCache.
'     they don't need to be connected to the same PivotTables

i have 4 slicers, slicer 1 is connected to pivot 1, 3 ,7; slicer 2 2 is connected to 1,2,3,4,5,6,7. Slicer 3 is connected to pivot 2,4,6,7
(the slicers and pivots mentioned are just examples, I can give the exact combinations of connections if needed).

does this matter for the code to run properly?
 
Upvote 0
i have this code to find all slicer caches:
Code:
Sub MultiplePivotSlicerCaches()
    Dim oSlicer As Slicer
    Dim oSlicercache As SlicerCache
    Dim oPT  As pivotTable
    Dim oSh As Worksheet
       
    Set objnewsheet = worksheets.Add
    objnewsheet.Activate
 
 iRow = 1
 

    For Each oSlicercache In ThisWorkbook.SlicerCaches
        For Each oPT In oSlicercache.PivotTables
            objnewsheet.Cells(iRow, 1) = oSlicercache.Name & ", " & oPT.Name & ", " & oPT.Parent.Name
            iRow = iRow + 1
        Next
    Next

End Sub
I ran this code before running all scripts to update the workbook.
The result was this:
Code:
Slicer_FCT1, Draaitabel1, draaitabel food-drug (2)
Slicer_FCT1, Draaitabel1, draaitabel food-drug (3)
Slicer_FCT1, Draaitabel1, draaitabel food-drug
Slicer_FCT1, Draaitabel2, totale segmenten
Slicer_FCT1, Draaitabel1, draaitabel food-drug (4)
Slicer_FCT1, Draaitabel3, draaitabel food-drug
Slicer_FCT1, Draaitabel4, draaitabel food-drug
Slicer_FCT1, Draaitabel5, draaitabel food-drug
Slicer_FCT1, Draaitabel3, draaitabel food-drug (2)
Slicer_FCT1, Draaitabel4, draaitabel food-drug (2)
Slicer_FCT1, Draaitabel5, draaitabel food-drug (2)
Slicer_FCT1, Draaitabel3, draaitabel food-drug (3)
Slicer_FCT1, Draaitabel4, draaitabel food-drug (3)
Slicer_FCT1, Draaitabel5, draaitabel food-drug (3)
Slicer_FCT1, Draaitabel3, draaitabel food-drug (4)
Slicer_FCT1, Draaitabel4, draaitabel food-drug (4)
Slicer_FCT1, Draaitabel5, draaitabel food-drug (4)
Slicer_FCT1, Draaitabel6, totale segmenten
Slicer_FCT1, Draaitabel7, totale segmenten
Slicer_FCT1, Draaitabel9, totale segmenten
Slicer_FCT1, Draaitabel4, totale segmenten (2)
Slicer_FCT1, Draaitabel3, totale segmenten (2)
Slicer_FCT1, Draaitabel1, totale segmenten (2)
Slicer_FCT1, Draaitabel5, totale segmenten (2)
Slicer_MKT, Draaitabel1, draaitabel food-drug (3)
Slicer_MKT, Draaitabel3, draaitabel food-drug (3)
Slicer_MKT, Draaitabel4, draaitabel food-drug (3)
Slicer_MKT, Draaitabel5, draaitabel food-drug (3)
Slicer_MKT, Draaitabel1, draaitabel food-drug
Slicer_MKT, Draaitabel3, draaitabel food-drug
Slicer_MKT, Draaitabel4, draaitabel food-drug
Slicer_MKT, Draaitabel5, draaitabel food-drug
Slicer_PROD, Draaitabel1, draaitabel food-drug (4)
Slicer_PROD, Draaitabel3, draaitabel food-drug (4)
Slicer_PROD, Draaitabel4, draaitabel food-drug (4)
Slicer_PROD, Draaitabel5, draaitabel food-drug (4)
Slicer_MERK, Draaitabel1, draaitabel food-drug (3)
Slicer_MERK, Draaitabel1, draaitabel food-drug (2)
Slicer_MERK, Draaitabel3, draaitabel food-drug (2)
Slicer_MERK, Draaitabel4, draaitabel food-drug (2)
Slicer_MERK, Draaitabel5, draaitabel food-drug (2)
Slicer_MERK, Draaitabel3, draaitabel food-drug (3)
Slicer_MERK, Draaitabel4, draaitabel food-drug (3)
Slicer_MERK, Draaitabel5, draaitabel food-drug (3)
Slicer_MERK, Draaitabel1, draaitabel food-drug (4)
Slicer_MERK, Draaitabel3, draaitabel food-drug (4)
Slicer_MERK, Draaitabel4, draaitabel food-drug (4)
Slicer_MERK, Draaitabel5, draaitabel food-drug (4)
after that I run the codes to update the workbook and all the data. I received the error 5 again.
After the error, I ran the same code again to check the slicer caches and now the result is this:
Slicer_PROD, Draaitabel1, draaitabel food-drug (4)
Slicer_PROD, Draaitabel3, draaitabel food-drug (4)
Slicer_PROD, Draaitabel4, draaitabel food-drug (4)
Slicer_PROD, Draaitabel5, draaitabel food-drug (4)
Slicer_MERK, Draaitabel1, draaitabel food-drug (3)
Slicer_MERK, Draaitabel1, draaitabel food-drug (2)
Slicer_MERK, Draaitabel3, draaitabel food-drug (2)
Slicer_MERK, Draaitabel4, draaitabel food-drug (2)
Slicer_MERK, Draaitabel5, draaitabel food-drug (2)
Slicer_MERK, Draaitabel3, draaitabel food-drug (3)
Slicer_MERK, Draaitabel4, draaitabel food-drug (3)
Slicer_MERK, Draaitabel5, draaitabel food-drug (3)
Slicer_MERK, Draaitabel1, draaitabel food-drug (4)
Slicer_MERK, Draaitabel3, draaitabel food-drug (4)
Slicer_MERK, Draaitabel4, draaitabel food-drug (4)
Slicer_MERK, Draaitabel5, draaitabel food-drug (4)
so something happened to the slicers and their caches....
my complete code is now:
Code:
Sub vernieuwalles()

Call NITRO.RefreshDataAllWorksheets
Call datawissen

ThisWorkbook.Save
End Sub
Sub datawissen()

Application.ScreenUpdating = False

Laatsteregel = Sheets("schaduwblad").Cells.SpecialCells(xlCellTypeLastCell).Row
Laatstekolom = Sheets("schaduwblad").Cells.SpecialCells(xlCellTypeLastCell).Column

adres = Sheets("schaduwblad").Cells(Laatsteregel, Laatstekolom).Address

Sheets("schaduwblad").Range("A1", adres).ClearContents
Application.ScreenUpdating = True
Call dataplaatsen
End Sub

Sub dataplaatsen()
Application.ScreenUpdating = False
Sheetnames = Array("food-drug", "food-drug (2)", "aswatson", "aswatson (2)", "food", "food (2)")
For i = LBound(Sheetnames) To UBound(Sheetnames)
    With Sheets(Sheetnames(i))
        .Range(.Range("U2"), .Cells(.Rows.Count, 1).End(xlUp)).Copy Sheets("Schaduwblad").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    End With
Next i
     
Application.ScreenUpdating = True

Call kolomtitels
 
End Sub
Sub kolomtitels()
With Sheets("schaduwblad")
    Sheets("food-drug").Range("a1", "F1").Copy Sheets("schaduwblad").Range("A1", "F1")
       
.[g1].Value = "4w periode -2"
.[h1].Value = "4w periode -1"
.[i1].Value = "4w periode"
.[j1].Value = "--"
.[k1].Value = "Last 12 wks -2"
.[l1].Value = "Last 12 wks -1"
.[m1].Value = "Last 12 wks 0"
.[n1].Value = "--"
.[o1].Value = "YTD-2"
.[p1].Value = "YTD-1"
.[q1].Value = "YTD-0"
.[r1].Value = "--"
.[s1].Value = "MAT-2"
.[t1].Value = "MAT-1"
.[u1].Value = "MAT-0"
.[v1].Value = "waarde 4w positief"
.[w1].Value = "waarde 12w positief"
.[x1].Value = "waarde YTD positief"
.[y1].Value = "waarde MAT positief"
.[z1].Value = "merk ja/nee"
.[aa1].Value = "item ja/nee"

End With
Call toevoegen

End Sub
Sub toevoegen()
 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With Worksheets("schaduwblad")
    For Each cel In .Range(.[a2], .[a1000000].End(xlUp))
        For i = 0 To 3
            If cel.Offset(0, 7 + i * 4) > 0 Then
                cel.Offset(0, 21 + i) = "ja"
            Else
                cel.Offset(0, 21 + i) = "nee"
            End If
        Next i
        
        If cel.Offset(0, 3) = "" Then
            cel.Offset(0, 25) = "nee"
        Else
            cel.Offset(0, 25) = "ja"
        End If
        
        If cel.Offset(0, 4) = "" Then
            cel.Offset(0, 26) = "nee"
        Else
            cel.Offset(0, 26) = "ja"
        End If
    Next cel
End With
Call maaktabel

End Sub
Sub maaktabel()
  
Dim rLastCell As Range
With Sheets("schaduwblad")
Set rLastCell = .Cells.Find(What:="*", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)
'MsgBox ("The last used column is: " & rLastCell.Address)
     'Maak tabel gewoon bereik
    '.ListObjects("Tabel3").Unlist
    .ListObjects.Add(xlSrcRange, .Range("A1", rLastCell.Address), _
                                 , xlYes).Name = "Tabel3"
                                 
  
                                 
End With
Call Change_slicers
End Sub
Sub Change_slicers()
'---changes source data of pivots connected to specified slicers
Dim dicPivotIDs As Object
Dim vSlicers() As Variant, vSlicerList() As Variant, vKey As Variant
Dim PT As PivotTable, PT1 As PivotTable
Dim sPivotID As String, sNewSource As String
Dim iSlicer As Long, iPivot As Long, lItem As Long
'--edit list of slicers. They must share the same PivotCache.
'     they don't need to be connected to the same PivotTables
vSlicerList = Array("Slicer_MKT", "Slicer_FCT1", "Slicer_MERK_GEZ1", "Slicer_PROD")
'--edit with range reference to new PivotCache datasource
On Error GoTo ErrHandler
'  example1: reference an existing Named Range with Workbook scope
'sNewSource = "MyPivotData"
'  example2: reference an existing Table (ListObject)
sNewSource = "Tabel3"
'  example3: other range reference
'sNewSource = Sheets("Sheet1").Range("A1").CurrentRegion.Address
Set dicPivotIDs = CreateObject("Scripting.Dictionary")
ReDim vSlicers(LBound(vSlicerList) To UBound(vSlicerList))
'--build array of arrays mapping each Slicer's connected PivotTables
For iSlicer = LBound(vSlicerList) To UBound(vSlicerList)
   With ActiveWorkbook.SlicerCaches(vSlicerList(iSlicer)).PivotTables
      If .Count Then
         ReDim vPivots(1 To .Count)
         For iPivot = .Count To 1 Step -1
            Set PT = .Item(iPivot)
            Set vPivots(iPivot) = PT
            .RemovePivotTable (PT)
            '--add unique pivot identifiers to dictionary
            sPivotID = "'" & PT.Parent.Name & "'!" & _
               PT.TableRange1.Cells(1).Address
            If Not dicPivotIDs.Exists(sPivotID) Then
               lItem = lItem + 1
               dicPivotIDs.Add sPivotID, lItem
            End If
         Next iPivot
         vSlicers(iSlicer) = vPivots
      End If
   End With
Next iSlicer
'---change datasource of all pivots
For Each vKey In dicPivotIDs.Keys
   If PT1 Is Nothing Then
      Set PT1 = Range(vKey).PivotTable
      PT1.ChangePivotCache _
            ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
            SourceData:=sNewSource)
   Else
      Range(vKey).PivotTable.CacheIndex = PT1.CacheIndex
   End If
Next vKey
'--reconnect Pivots to Slicers using stored mapping
For iSlicer = LBound(vSlicers) To UBound(vSlicers)
   If Not IsEmpty(vSlicers(iSlicer)) Then
      With ActiveWorkbook.SlicerCaches(vSlicerList(iSlicer)).PivotTables
         For iPivot = LBound(vSlicers(iSlicer)) To UBound(vSlicers(iSlicer))
            .AddPivotTable vSlicers(iSlicer)(iPivot)
         Next iPivot
      End With
   End If
Next iSlicer
 
Exit Sub
ErrHandler:
   MsgBox Err.Number & ": " & Err.Description
ThisWorkbook.Save

End Sub
i'm wondering what happens during those codes that I get totally different results for the slicers the second time
 
Upvote 0
i saw I used a wrong name for one of the slicers which caused the error.
After correcting this, I ran the code again and now I did not get an error, but still, I'm missing a lot of slicers/pivots combinations.
Now the result is:
Code:
Slicer_FCT1    Draaitabel2    totale segmenten
Slicer_FCT1    Draaitabel6    totale segmenten
Slicer_FCT1    Draaitabel7    totale segmenten
Slicer_FCT1    Draaitabel9    totale segmenten
Slicer_FCT1    Draaitabel4    totale segmenten (2)
Slicer_FCT1    Draaitabel3    totale segmenten (2)
Slicer_FCT1    Draaitabel1    totale segmenten (2)
Slicer_FCT1    Draaitabel5    totale segmenten (2)
Slicer_MKT    Draaitabel1    draaitabel food-drug
Slicer_MKT    Draaitabel3    draaitabel food-drug
Slicer_MKT    Draaitabel4    draaitabel food-drug
Slicer_MKT    Draaitabel5    draaitabel food-drug
Slicer_PROD    Draaitabel1    draaitabel food-drug (4)
Slicer_PROD    Draaitabel3    draaitabel food-drug (4)
Slicer_PROD    Draaitabel4    draaitabel food-drug (4)
Slicer_PROD    Draaitabel5    draaitabel food-drug (4)
Slicer_MERK    Draaitabel1    draaitabel food-drug (4)
Slicer_MERK    Draaitabel3    draaitabel food-drug (4)
Slicer_MERK    Draaitabel4    draaitabel food-drug (4)
Slicer_MERK    Draaitabel5    draaitabel food-drug (4)

these pivots/slicers are missing now:
Code:
Slicer_FCT1	 Draaitabel1	 draaitabel food-drug
Slicer_FCT1	 Draaitabel3	 draaitabel food-drug
Slicer_FCT1	 Draaitabel4	 draaitabel food-drug
Slicer_FCT1	 Draaitabel5	 draaitabel food-drug
Slicer_FCT1	 Draaitabel1	 draaitabel food-drug (2)
Slicer_FCT1	 Draaitabel3	 draaitabel food-drug (2)
Slicer_FCT1	 Draaitabel4	 draaitabel food-drug (2)
Slicer_FCT1	 Draaitabel5	 draaitabel food-drug (2)
Slicer_FCT1	 Draaitabel1	 draaitabel food-drug (3)
Slicer_FCT1	 Draaitabel3	 draaitabel food-drug (3)
Slicer_FCT1	 Draaitabel4	 draaitabel food-drug (3)
Slicer_FCT1	 Draaitabel5	 draaitabel food-drug (3)
Slicer_FCT1	 Draaitabel1	 draaitabel food-drug (4)
Slicer_FCT1	 Draaitabel3	 draaitabel food-drug (4)
Slicer_FCT1	 Draaitabel4	 draaitabel food-drug (4)
Slicer_FCT1	 Draaitabel5	 draaitabel food-drug (4)
Slicer_MERK	 Draaitabel1	 draaitabel food-drug (2)
Slicer_MERK	 Draaitabel3	 draaitabel food-drug (2)
Slicer_MERK	 Draaitabel4	 draaitabel food-drug (2)
Slicer_MERK	 Draaitabel5	 draaitabel food-drug (2)
Slicer_MERK	 Draaitabel1	 draaitabel food-drug (3)
Slicer_MERK	 Draaitabel3	 draaitabel food-drug (3)
Slicer_MERK	 Draaitabel4	 draaitabel food-drug (3)
Slicer_MERK	 Draaitabel5	 draaitabel food-drug (3)
Slicer_MKT	 Draaitabel1	 draaitabel food-drug (3)
Slicer_MKT	 Draaitabel3	 draaitabel food-drug (3)
Slicer_MKT	 Draaitabel4	 draaitabel food-drug (3)
Slicer_MKT	 Draaitabel5	 draaitabel food-drug (3)
 
Last edited:
Upvote 0
That's interesting. The loop beginning with For iPivot = .Count To 1 Step -1
loses track of order of the items in the collection as a result of the .PivotTables.RemovePivotTable (PT) statement, but only for those PivotTables that have the same name on different sheets. The code works fine if each PivotTable in the workbook is given a unique name.

Using a For Each ...Next construct seems to overcome this problem. Try....

Code:
Sub Change_SourceData_Of_MultipleSlicer_Connected_Pivots()
'---changes source data of pivots connected to specified slicers
Dim dicPivotIDs As Object
Dim vSlicers() As Variant, vSlicerList() As Variant, vKey As Variant
Dim PT As PivotTable, PT1 As PivotTable
Dim sPivotID As String, sNewSource As String
Dim iSlicer As Long, iPivot As Long, lItem As Long

'--edit list of slicers. They must share the same PivotCache.
'     they don't need to be connected to the same PivotTables
vSlicerList = Array("Slicer_Field1", "Slicer_Field2", "Slicer_Field3")

'--edit with range reference to new PivotCache datasource
On Error GoTo ErrHandler
'  example1: reference an existing Named Range with Workbook scope
'sNewSource = "MyPivotData"
'  example2: reference an existing Table (ListObject)
sNewSource = "Table1"
'  example3: other range reference
'sNewSource = Sheets("Sheet1").Range("A1").CurrentRegion.Address

Set dicPivotIDs = CreateObject("Scripting.Dictionary")
ReDim vSlicers(LBound(vSlicerList) To UBound(vSlicerList))

'--build array of arrays mapping each Slicer's connected PivotTables
For iSlicer = LBound(vSlicerList) To UBound(vSlicerList)
   With ActiveWorkbook.SlicerCaches(vSlicerList(iSlicer))
      If .PivotTables.Count Then
         ReDim vPivots(1 To .PivotTables.Count)
         For Each PT In .PivotTables
            iPivot = iPivot + 1
            Set vPivots(iPivot) = PT
            '--add unique pivot identifiers to dictionary
            sPivotID = "'" & PT.Parent.Name & "'!" & _
               PT.TableRange1.Cells(1).Address
            If Not dicPivotIDs.Exists(sPivotID) Then
               lItem = lItem + 1
               dicPivotIDs.Add sPivotID, lItem
            End If
            '--disconnect from slicer
            .PivotTables.RemovePivotTable (PT)
         Next PT
         vSlicers(iSlicer) = vPivots
         iPivot = 0
      End If
   End With
Next iSlicer

'---change datasource of all pivots
For Each vKey In dicPivotIDs.Keys
   If PT1 Is Nothing Then
      Set PT1 = Range(vKey).PivotTable

      PT1.ChangePivotCache _
            ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
            SourceData:=sNewSource)
   Else
      Range(vKey).PivotTable.CacheIndex = PT1.CacheIndex
   End If
Next vKey

'--reconnect Pivots to Slicers using stored mapping
For iSlicer = LBound(vSlicers) To UBound(vSlicers)
   If Not IsEmpty(vSlicers(iSlicer)) Then
      With ActiveWorkbook.SlicerCaches(vSlicerList(iSlicer)).PivotTables
         For iPivot = LBound(vSlicers(iSlicer)) To UBound(vSlicers(iSlicer))
            .AddPivotTable vSlicers(iSlicer)(iPivot)
         Next iPivot
      End With
   End If
Next iSlicer

MsgBox "The PivotTables' data source have been updated"

Exit Sub
ErrHandler:
   MsgBox Err.Number & ": " & Err.Description
End Sub
 
Upvote 0
i already thought the duplicate pivot names might be part of the problem. I will change them to unique names and try again. Or I will try the new code you've posted.

on totally other question: I'm searching for the edit button to edit my posts to add new info to a post, instead of posting a new reply, but I can't find it. Is that correct?
 
Upvote 0

Forum statistics

Threads
1,223,632
Messages
6,173,472
Members
452,516
Latest member
archcalx

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top