VBA to connect slicers (looking for improvements to code)

后端 未结 2 1752
臣服心动
臣服心动 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
    
    0 讨论(0)
  • 2020-12-07 05:07

    If you only want the user to select just one item at a time, you can do this very quickly by using the following trick that leverages off a quirk to do with PageFields. Here's an example where I sync three different PivotTables that are on different caches.

    1. Set up a slave PivotTable for each of the master PivotTables somewhere out of sight, and put the field of interest in each of them as a PageField, like this:

    2. Make sure the 'Select Multiple Items' checkbox is deselected for each of those slave PivotTables:
    3. Add a Slicer to each of those Slaves. Again, these will be somewhere out of sight:
    4. Connect each of those Slicers up to the actual PivotTables you had to begin with. (i.e. connect each hidden Slicer to it's visible counterpart PivotTable using the Report Connections box.

    Now this is where the clever hack comes in: We move the Slicer that is connected to the PivotTable1 Slave PivotTable into the main sheet so the user can click on it. When they select an item using it, it generates a PivotTable_Update event for that PivotTable1 Slave PivotTable, which we keep an eye out for. And then we set the .PageField of those other slave PivotTables to match the .PageField of the PivotTable1 Slave PivotTable. And then more magic happens: that single selection in those slave PageFields gets replicated in the master PivotTables thanks to those hidden Slicers we set up earlier. No VBA neccessary. No slow iteration necessary. Just lightning fast syncing.

    Here's how the entire setup looks:

    ...and this will work even if the field you want to filter on isn't visible in any of your pivots:

    Here's the code that achieves this:

    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
    
    '########################
    '# Change these to suit #
    '########################
    
    Const sField As String = "Name"
    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
    
    errhandler:
        With Application
            .ScreenUpdating = True
            .Calculation = xlCalculationAutomatic
            .EnableEvents = True
        End With
    End If
    
    End Sub
    

    There's a bit of code in there to ensure that the user can't select more than one item in the slicer at a time.

    But what if you want the User to be able to select multiple items?

    If you want the user to be able to select multiple items, things become way, way more complicated. For starters, you need to set each PivotTable's ManualUpdate property to TRUE so that they don't refresh ater each and every PivotItems changes. And even then, it can take minutes to sync just one PivotTable if it has say 20,000 items in it. I've got a good post on this at the following link that I'd recommend you read, that shows just how long it takes to perform different actions when it comes to iterate through a large number of PivotItems: http://dailydoseofexcel.com/archives/2013/11/14/filtering-pivots-based-on-external-ranges/

    Even then, you have a lot of other challenges to overcome depending on what you're doing. Slicers seem to really slow things down, for starters. Read my post at http://dailydoseofexcel.com/archives/2015/11/17/filtering-pivottables-with-vba-deselect-slicers-first/ for more on this.

    I'm in the final stages of launching a commercial addin that does a lot of this stuff lightning fast, but launch is at least a month away.

    0 讨论(0)
提交回复
热议问题