Challenge: VBA run-time error

[Dmitry_V]

Hi fellow VBA practitioners,

Today I have a challenging (maybe not?) exercise for those of you who know VBA. The case I'm about to describe is pretty simple, however completely kills all my weekend (second one to be precise).

Case
I managed to find & modify to suit my case the macro that would synch slicers for pivots with different data-sources. However, when the macro is triggered, it produces the Run-time error -2147417848(80010108): "Method 'Selected' of object 'SlicerItem' failed" on the line of code:

oSc.SlicerItems(oSc.SlicerItems.Count).Selected = True

Alternatives
As a resolution to the above, I tried variety of things, for example, amending the above line to the following:

oSc.SlicerItems.Item(oSc.SlicerItems.Count).Selected = True

Besides that, I ensured that the items in the slicers are 100% identical, doesn't contain "blank" items, or the ones with #VALUE error

The facts
- 4 pivot-tables (3 pivots from 1 data-source, 1 pivot from another data-source)
- 4 slicers for the 3 pivots, and 4 more for another.
- The slicers control following: Forecast Period, Country, Location, and Product Variant.

The code

Private Sub Workbook_SheetPivotTableUpdate(ByVal Sh As Object, ByVal Target As PivotTable)

    Dim oScForecast As SlicerCache
    Dim oScCountry As SlicerCache
    Dim oScLocation As SlicerCache
    Dim oScBrandVariant As SlicerCache
    
    Dim oSc As SlicerCache
    Dim oPT As PivotTable
    Dim oSi As SlicerItem
    Dim bUpdate As Boolean
    Dim mbNoEvent As Boolean
    
    'Prevent event looping, changing a slicer in this routine also triggers this routine
    If mbNoEvent Then Exit Sub
    mbNoEvent = True
    bUpdate = Application.ScreenUpdating
    Application.ScreenUpdating = False
    
    For Each oSc In ThisWorkbook.SlicerCaches
        For Each oPT In oSc.PivotTables
            If oPT.Name = Target.Name And oPT.Parent.Name = Target.Parent.Name Then
                If oSc.Name Like "*Forecast*" Then
                    Set oScForecast = oSc
                ElseIf oSc.Name Like "*Country*" Then
                    Set oScCountry = oSc
                ElseIf oSc.Name Like "*Location*" Then
                    Set oScLocation = oSc
                ElseIf oSc.Name Like "*Brand_Variant*" Then
                    Set oScBrandVariant = oSc
                End If
                Exit For
            End If
        Next
        If Not oScForecast Is Nothing And Not oScCountry Is Nothing And Not oScLocation Is Nothing And Not oScBrandVariant Is Nothing Then Exit For
    Next
    If Not oScForecast Is Nothing Then
        For Each oSc In ThisWorkbook.SlicerCaches
            If Mid(oSc.Name, 7, 3) = Mid(oScForecast.Name, 7, 3) And oSc.Name <> oScForecast.Name Then
                'This one has a similar fieldname (first three characters are compared in this case)
                'but not the same name, as that would be the same slicercache.
                'So synch it with the changed year slicer
                'If a slicer has the very first item selected and you subsequently de-select it,
                'the end result is that all sliceritems get selected. So select the last item of the slicer first
                
                'oSc.SlicerItems.Item(oSc.SlicerItems.Count).Selected = True
                
                oSc.SlicerItems(oSc.SlicerItems.Count).Selected = True
                For Each oSi In oScForecast.SlicerItems
                    On Error Resume Next
                    If oSc.SlicerItems(oSi.Value).Selected <> oSi.Selected Then
                        oSc.SlicerItems(oSi.Value).Selected = oSi.Selected
                    End If
                Next
            End If
        Next
    End If
    
    If Not oScCountry Is Nothing Then
        For Each oSc In ThisWorkbook.SlicerCaches
            If Mid(oSc.Name, 7, 3) = Mid(oScCountry.Name, 7, 3) And oSc.Name <> oScCountry.Name Then
                oSc.SlicerItems(oSc.SlicerItems.Count).Selected = True
                For Each oSi In oScCountry.SlicerItems
                    On Error Resume Next
                    If oSc.SlicerItems(oSi.Value).Selected <> oSi.Selected Then
                        oSc.SlicerItems(oSi.Value).Selected = oSi.Selected
                    End If
                Next
            End If
        Next
    End If
    
    If Not oScLocation Is Nothing Then
        For Each oSc In ThisWorkbook.SlicerCaches
            If Mid(oSc.Name, 7, 3) = Mid(oScLocation.Name, 7, 3) And oSc.Name <> oScLocation.Name Then
                oSc.SlicerItems(oSc.SlicerItems.Count).Selected = True
                For Each oSi In oScLocation.SlicerItems
                    On Error Resume Next
                    If oSc.SlicerItems(oSi.Value).Selected <> oSi.Selected Then
                        oSc.SlicerItems(oSi.Value).Selected = oSi.Selected
                    End If
                Next
            End If
        Next
    End If
    
    If Not oScBrandVariant Is Nothing Then
        For Each oSc In ThisWorkbook.SlicerCaches
            If Mid(oSc.Name, 7, 3) = Mid(oScBrandVariant.Name, 7, 3) And oSc.Name <> oScBrandVariant.Name Then
                oSc.SlicerItems(oSc.SlicerItems.Count).Selected = True
                For Each oSi In oScBrandVariant.SlicerItems
                    On Error Resume Next
                    If oSc.SlicerItems(oSi.Value).Selected <> oSi.Selected Then
                        oSc.SlicerItems(oSi.Value).Selected = oSi.Selected
                    End If
                Next
            End If
        Next
    End If
    mbNoEvent = False
    Application.ScreenUpdating = bUpdate

End Sub

*The credits for the code goes to jkp-ads.com

Could anyone please review the code, and suggest the resolution?

N.B. Yes, I presume that it would be possible to solve the issue with PowerPivot. However, I think I'm very close to the resolving the issue, and secondly (most important) it's the matter of principle (!) to solve & find out what's cause.

 

[Dmitry_V]

Is there a kind person who's interested in investigating this issue together with me...?