VBA to connect slicers (looking for improvements to code)

后端 未结 2 1763
臣服心动
臣服心动 2020-12-07 04:17

I finally found a code that will connect slicers with different caches on pivot table update. Basically when the value of slicer1 changes, it will change slicer2 to match sl

2条回答
  •  忘掉有多难
    2020-12-07 04:48

    I'm unsure what I'm doing incorrect. I posted my code below, I'm not hitting any errors, it's simply just not updating any of the other slicers/fields. Upon first test, the Department slicer updated all the tables once, but then would not clear the filter or allow another selection, as far as the Month slicer, I haven't gotten it to work at all. Do I perhaps need to duplicate each item so that it's separately identifiable? As in Dim sCurrentPage As String and Dim sCurrentPage2 As String. Thank you so much for your continued assistance with this, I've never wanted the weekend to come so badly while working on a spreadsheet before.

    Option Explicit
    
    Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
    
    Dim pt As PivotTable
    Dim pf As PivotField
    Dim sCurrentPage As String
    Dim vItem As Variant
    Dim vArray As Variant
    Dim sField As String
    
    '########################
    '# Change these to suit #
    '########################
    
    sField = "Department"
    vArray = Array("PivotTable2 Slave", "PivotTable3 Slave")
    
    
    If Target.Name = "PivotTable1 Slave" Then
        On Error GoTo errhandler
        With Application
            .ScreenUpdating = False
            .Calculation = xlCalculationManual
            .EnableEvents = False
        End With
    
        'Find out what item they just selected
        Set pf = Target.PivotFields(sField)
        With pf
            If .EnableMultiplePageItems Then
                .ClearAllFilters
                .EnableMultiplePageItems = False
                sCurrentPage = "(All)"
            Else:
                sCurrentPage = .CurrentPage
            End If
        End With
    
        'Change the other slave pivots to match. Slicers will pass on those settings
        For Each vItem In vArray
            Set pt = ActiveSheet.PivotTables(vItem)
            Set pf = pt.PivotFields(sField)
            With pf
                If .CurrentPage <> sCurrentPage Then
                    .ClearAllFilters
                    .CurrentPage = sCurrentPage
                End If
            End With
        Next vItem
    
    '########################
    
    sField = "Month"
    vArray = Array("PivotTable2 Slave2", "PivotTable3 Slave2")
    
    
    If Target.Name = "PivotTable1 Slave2" Then
        On Error GoTo errhandler
        With Application
            .ScreenUpdating = False
            .Calculation = xlCalculationManual
            .EnableEvents = False
        End With
    
        'Find out what item they just selected
        Set pf = Target.PivotFields(sField)
        With pf
            If .EnableMultiplePageItems Then
                .ClearAllFilters
                .EnableMultiplePageItems = False
                sCurrentPage = "(All)"
            Else:
                sCurrentPage = .CurrentPage
            End If
        End With
    
        'Change the other slave pivots to match. Slicers will pass on those settings
        For Each vItem In vArray
            Set pt = ActiveSheet.PivotTables(vItem)
            Set pf = pt.PivotFields(sField)
            With pf
                If .CurrentPage <> sCurrentPage Then
                    .ClearAllFilters
                    .CurrentPage = sCurrentPage
                End If
            End With
        Next vItem
    
    errhandler:
        With Application
            .ScreenUpdating = True
            .Calculation = xlCalculationAutomatic
            .EnableEvents = True
        End With
    End If
    
    End Sub
    

提交回复
热议问题