Using VBA to Connect Slicers to All Pivot Tables?

Question

I am working on VBA code to generate a range of 12 Pivot Tables that are all connected to the same slicers.

In order to connect the slicers to the pivot tables, I implemented a round about method where the first Pivot table is generated via code, and then all slicers are connected to this pivot table. The first pivot table is then copied and pasted offset by 2 columns to the right, cleared, renamed and then populated with the relevant pivot fields. This is then repeated for the remaining pivot tables.

Here is an example of the code:

Sub Pivot_Generation()

Application.ScreenUpdating = False
    
    Sheets("Pivots").Activate

Dim TblNam As String
Dim TblRk As Integer

TblRank = 1

' Creation of the first pivot table

    ThisWorkbook.PivotCaches.Create(SourceType:=xlExternal, SourceData:= _
        ThisWorkbook.Connections("ThisWorkbookDataModel"), Version:=6). _
        CreatePivotTable TableDestination:="Pivots!R3C3", tableName:= _
        "NewPivot", DefaultVersion:=6

    For i = 1 To 3
        If TblRank = 1 Then
            TblNam = "Pivot1” 
        ElseIf TblRank = 2 Then
            TblNam = " Pivot2 "
        ElseIf TblRank = 3 Then
            TblNam = " Pivot3 "
        End If

    If TblRank = 1 Then
        ActiveSheet.pivotTables(1).name = TblNam
        Pivot1_Fields
        Slicers
    Else:
        ActiveSheet.pivotTables(1).TableRange1.Select
        Selection.Copy
        Selection.Cells(1, 1).Select
        Selection.End(xlToRight).End(xlToRight).End(xlToLeft).Offset(0, 2).Select
        ActiveSheet.Paste
        ActiveSheet.pivotTables(1).ClearTable
        ActiveSheet.pivotTables(1).name = TblNam

            If TblRank = 2 Then
                Pivot2_Fields
            ElseIf TblRank = 3 Then
                Pivot3_Fields
            End If
        End If
        TblRank = TblRank + 1

    Next i
End Sub

The module "Slicers" is used to generate and connect the slicers to the first pivot table in this way:

Sub Slicers()

Dim conc As Worksheet
Set conc = Sheets("Pivots")

'Visible Slicers

    ThisWorkbook.SlicerCaches.Add2(conc.pivotTables("Pivot1"), _
        "[ORDER_DATA].[account_status]").Slicers.Add conc, _
        "[ORDER_DATA].[account_status].[account_status]", _
        "Account Status", "Account Status", 30, 0, 135, 90

    ThisWorkbook.SlicerCaches.Add2(conc.pivotTables("Pivot1"), _
        "[ORDER_DATA].[order_type]").Slicers.Add conc, _
        "[ORDER_DATA].[order_type].[order_type]", _
        "Order Type", "Order Type", 135, _
        0, 135, 105

    ThisWorkbook.SlicerCaches.Add2(conc.pivotTables("Pivot1"), _
        "[ORDER_DATA].[store_id]").Slicers.Add conc, _
        "[ORDER_DATA].[store_id].[store_id]", "Store ID" _
        , "Store ID", 255, 0, 135, 90

End Sub

Here's the problem I am running into. Even though this method has successfully work in making sure all Pivot Tables were connected to the same slicers in the past, it is no longer working. Now it is only connecting the slicers to the first Pivot Table and not connecting to the remaining Pivot Tables after they are copied over. The only solution that I can come up with is to manually connect all slicers to all Pivot Tables with modules, which is not ideal as that would add more time to the Dashboard Generation.

Is there more efficient method I can use to make sure that all Pivot Tables are connected to the same slicers?

Answer 1

• If the slicer is created before copying the pivot table, the new pivot table should be connected to the slicer. I've tested this without any issues on Excel 365.

• In case it doesn't work on your end for unknown reasons, you can use the following code to connect all slicers to all pivot tables. (Assumes all pivottables are created with the same pivotcache.)

Option Explicit

Sub demo()
    Dim Sc As SlicerCache, Pvt As PivotTable
    For Each Sc In ActiveWorkbook.SlicerCaches
        For Each Pvt In ActiveSheet.PivotTables
            Sc.PivotTables.AddPivotTable Pvt
        Next
    Next
End Sub