Run time error 1004 - cannot sync slicer caches with different size

[whitehawk81]

Hi,

I get run time error 1004 when I run the following code, which should synchronize the slicer caches:

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)Dim sc1 As SlicerCache
Dim sc2 As SlicerCache
Dim si1 As SlicerItem


Set sc1 = ThisWorkbook.SlicerCaches("Slicer_SolName")
Set sc2 = ThisWorkbook.SlicerCaches("Slicer_Sname")


Application.ScreenUpdating = False
Application.EnableEvents = False


sc2.ClearManualFilter


For Each si1 In sc1.SlicerItems
    sc2.SlicerItems(si1.Name).Selected = si1.Selected    '---->I get the error here
Next si1




MsgBox "Update Complete"


clean_up:
        Application.EnableEvents = True
        Application.ScreenUpdating = True
        Exit Sub


err_handle:
        MsgBox Err.Description
        Resume clean_up
End Sub

I would need this, because I have two data sets, both have pivot tables and I would like to control both with one slicer.
Unfortunately I don't have the same number of slicer items in both caches.
I also tried it with another code, that uses the smaller slicer as primary, but I get the same error, when I disable the error handlers:

[COLOR=#333333][FONT=Menlo]Private Sub Worksheet_PivotTableUpdate _[/FONT][/COLOR]    (ByVal Target As PivotTable)
Dim wb As Workbook
Dim scShort As SlicerCache
Dim scLong As SlicerCache
Dim siShort As SlicerItem
Dim siLong As SlicerItem

On Error GoTo errHandler
Application.ScreenUpdating = False
Application.EnableEvents = False

Set wb = ThisWorkbook
Set scShort = wb.SlicerCaches("Slicer_City")
Set scLong = wb.SlicerCaches("Slicer_City1")

scLong.ClearManualFilter

For Each siLong In scLong.VisibleSlicerItems
    Set siLong = scLong.SlicerItems(siLong.Name)
    Set siShort = Nothing
    On Error Resume Next
    Set siShort = scShort.SlicerItems(siLong.Name)
    On Error GoTo errHandler
    If Not siShort Is Nothing Then
        If siShort.Selected = True Then
            siLong.Selected = True
        ElseIf siShort.Selected = False Then
            siLong.Selected = False
        End If
    Else
        siLong.Selected = False
    End If
Next siLong

exitHandler:
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Exit Sub

errHandler:
    MsgBox "Could not update pivot table"
    Resume exitHandler
 [COLOR=#333333][FONT=Menlo]End Sub[/FONT][/COLOR]

Could you tell me, what I'm doing wrong here? Is this even possible, if the slicers don't contain the same amount of items?

 

[Worf]

Hi

You have to enable the error handlers, because the code may refer to a non-existing item, since the lists are not identical.

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
Dim sc1 As SlicerCache, sc2 As SlicerCache, si1 As SlicerItem


Set sc1 = ThisWorkbook.SlicerCaches("Slicer_quarter")
Set sc2 = ThisWorkbook.SlicerCaches("Slicer_quarter2")
Application.EnableEvents = False
sc2.ClearManualFilter
On Error Resume Next
For Each si1 In sc1.SlicerItems
    sc2.SlicerItems(si1.Name).Selected = si1.Selected
Next
On Error GoTo 0
MsgBox "Update Complete"


clean_up:
        Application.EnableEvents = True
        Application.ScreenUpdating = True
        Exit Sub


err_handle:
        MsgBox Err.Description
        Resume clean_up
End Sub

 

[whitehawk81]

Hi Worf,
thanks for the help! It works perfectly now.

 

[Worf]

You are welcome and thanks for the feedback.