none
PowerPivot PivotTable Slicer Selection - Modify this UDF to capture the selection RRS feed

  • Question

  • I've found online a couple of UDFs that can capture the selection of a Slicer of a PivotTable, however, they only work if the PivotTable is based on an Excel table. If it is a PowerPivot PivotTable (like in my case), they don't work.

    This post PowerPivot Slicer selection based on cell value using VBA explains that when using a PowerPivot PivotTable, you need to access the SlicerCacheLevel object, not the SlicerCache.

    If anyone can help modify the following UDFs to work for PowerPivot PivotTables slicers, that would be fantastic and I think many fellow Excel users will say a prayer for your help.

    I will post here the two UDFs and their sources: The first one: 'http://www.jkp-ads.com/Articles/slicers05.asp

    Public Function GetSelectedSlicerItems(SlicerName As String) As String
        Dim oSc As SlicerCache
        Dim oSi As SlicerItem
        Dim lCt As Long
        On Error Resume Next
        Application.Volatile
        Set oSc = ThisWorkbook.SlicerCaches(SlicerName)
        If Not oSc Is Nothing Then
            For Each oSi In oSc.SlicerItems
                If oSi.Selected Then
                    GetSelectedSlicerItems = GetSelectedSlicerItems & oSi.Name & ", "
                    lCt = lCt + 1
                ElseIf oSi.HasData = False Then
                    lCt = lCt + 1
                End If
            Next
            If Len(GetSelectedSlicerItems) > 0 Then
                If lCt = oSc.SlicerItems.Count Then
                    GetSelectedSlicerItems = "All"
                Else
                    GetSelectedSlicerItems = Left(GetSelectedSlicerItems, Len(GetSelectedSlicerItems) - 2)
                End If
            Else
                GetSelectedSlicerItems = "No items selected"
            End If
        Else
            GetSelectedSlicerItems = "No slicer with name '" & SlicerName & "' was found"
        End If
    End Function
    The second one: https://social.msdn.microsoft.com/Forums/office/en-US/d7893d81-938c-46d6-9b4c-7cd1b0b4fbf4/retrieve-the-value-selected-in-a-slicer?forum=exceldev

    Public Function FblSlicerSelections(Slicer_Name As String, Optional Delimiter As Variant, Optional Wrap_Length As Variant)
     ' Type Variant must be used for Optional Parameters for the IsMissing function to work below.
     Dim i, r, s As Integer: r = 1: s = 0 ' i = slicer Item, r = Rows in output, s = count of Selected items
     FblSlicerSelections = ""
     If IsMissing(Delimiter) Then Delimiter = " "
     If IsMissing(Wrap_Length) Then Wrap_Length = 40
     With ActiveWorkbook.SlicerCaches(Slicer_Name)
         For i = 1 To .SlicerItems.Count
             If .SlicerItems(i).Selected Then
                 s = s + 1 'Selected count increment
                 If .SlicerItems(i).HasData Then
                     If Len(FblSlicerSelections) > r * Wrap_Length Then
                         FblSlicerSelections = FblSlicerSelections & vbCr & "  "
                         r = r + 1.2 ' Modify multiplier used to determine when to wrap output (via carriage return)
                     End If
                     FblSlicerSelections = FblSlicerSelections & .SlicerItems(i).Value & Delimiter
                 End If
             End If
         Next i
         If s = .SlicerItems.Count Then FblSlicerSelections = "All" & Delimiter ' Selected count = SlicersItems.Count
     End With
     FblSlicerSelections = Left(FblSlicerSelections, Len(FblSlicerSelections) - Len(Delimiter)) ' remove extra delimiter
     End Function


    Friday, August 26, 2016 5:46 PM

Answers

  • Okay, panic over. I've managed to change both functions to now work with slicers from external sources (eg PowerPivot). I hope someone will benefit from these UDFs.

    Public Function GetSelectedSlicerItems(SlicerName As String) As String
    'http://www.jkp-ads.com/Articles/slicers05.asp
        Dim oSc As SlicerCacheLevel 'SlicerCache
        Dim oSi As SlicerItem
        Dim lCt As Long
        On Error Resume Next
        Application.Volatile
        
        Set oSc = ThisWorkbook.SlicerCaches(SlicerName).SlicerCacheLevels(1)
        
        If Not oSc Is Nothing Then
            For Each oSi In oSc.SlicerItems
                If oSi.Selected Then
                    GetSelectedSlicerItems = GetSelectedSlicerItems & oSi.Caption & ", " 'Initial code: oSi.Caption // There are 3 "choices": .Caption .Name .Value
                    lCt = lCt + 1
                ElseIf oSi.HasData = False Then
                    lCt = lCt + 1
                End If
            Next
            If Len(GetSelectedSlicerItems) > 0 Then
                If lCt = oSc.SlicerItems.Count Then
                    GetSelectedSlicerItems = "All"
                Else
                    GetSelectedSlicerItems = Left(GetSelectedSlicerItems, Len(GetSelectedSlicerItems) - 2)
                End If
            Else
                GetSelectedSlicerItems = "No items selected"
            End If
        Else
            GetSelectedSlicerItems = "No slicer with name '" & SlicerName & "' was found"
        End If
    End Function
    Public Function FblSlicerSelections(Slicer_Name As String, Optional Delimiter As Variant, Optional Wrap_Length As Variant)
    Application.Volatile
    'https://social.msdn.microsoft.com/Forums/office/en-US/d7893d81-938c-46d6-9b4c-7cd1b0b4fbf4/retrieve-the-value-selected-in-a-slicer?forum=exceldev
     ' Type Variant must be used for Optional Parameters for the IsMissing function to work below.
     Dim i, r, s As Integer: r = 1: s = 0 ' i = slicer Item, r = Rows in output, s = count of Selected items
     FblSlicerSelections = ""
     If IsMissing(Delimiter) Then Delimiter = " "
     If IsMissing(Wrap_Length) Then Wrap_Length = 40
     
     With ActiveWorkbook.SlicerCaches(Slicer_Name).SlicerCacheLevels(1)
         
         For i = 1 To .SlicerItems.Count
             
             If .SlicerItems(i).Selected Then
                 s = s + 1 ' Selected count increment
                 If .SlicerItems(i).HasData Then
                     If Len(FblSlicerSelections) > r * Wrap_Length Then
                         FblSlicerSelections = FblSlicerSelections & vbCr & "  "
                         r = r + 1.2 ' Modify multiplier used to determine when to wrap output (via carriage return)
                     End If
                     FblSlicerSelections = FblSlicerSelections & .SlicerItems(i).Value & Delimiter
                 End If
             End If
         Next i
         
         If s = .SlicerItems.Count Then FblSlicerSelections = "All" & Delimiter ' Selected count = SlicersItems.Count
     End With
     
     FblSlicerSelections = Left(FblSlicerSelections, Len(FblSlicerSelections) - Len(Delimiter)) ' remove extra delimiter
     End Function
    Friday, August 26, 2016 7:47 PM