0
votes

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
1

1 Answers

0
votes

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

And the second UDF:

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