简体   繁体   中英

Need VBA code to display multiple slicer selections in excel cell

This is my first shot using VBA. I need to display slicer selections in excel spreadsheets. There are 15-20 slicers in each sheet, with up to 50 possible selections, so I do not want to use the cube code to display one selection in each cell. I'd like them all to be separated by comma in one cell if possible (or return "all" or "none").

Here is what I have pieced together through research on this site and others, as well as attempting to edit it myself (so it is likely a complete mess).

I'm giving up searching and asking for help! And if you can point me to a simple, "crash course" VBA basics site, I'd appreciate it as well. Thank you.

Public Function GetSlicerItems()
Dim cache As Excel.SlicerCaches
Set cache = ThisWorkbook.SlicerCaches("Slicer_YR_MNTH_CD1")
Dim sItm As Excel.SlicerItem
Dim ICt As Long

For Each sItm In cache.SlicerItems
If sItm.Selected = True Then GetSlicerItems = GetSlicerItems & sItm.Name & ", "
ICt = ICt + 1
If sItm.HasData = False Then
ICt = ICt + 1
End If
Next
If Len(GetSlicerItems) > 0 Then
If ICt = cache.SlicerItems.Count Then
GetSlicerItems = "All Items"
Else
GetSlicerItems = Left(GetSlicerItems, Len(GetSlicerItems) - 2)
End If
Else
GetSlicerItems = "No items selected"
End If
End Function

Great approach Thanks for Sharing. The True and False If statement weren't working for me, so I just move to next line and now it works

Public Function GetSlicerItems() As String
    Dim sSlicerItems As String

    Dim cache As Excel.SlicerCache
    Set cache = ThisWorkbook.SlicerCaches("Slicer_AUTH_BHS_GROUP")

    Dim sItm As Excel.SlicerItem
    Dim ICt As Long

    For Each sItm In cache.SlicerItems
        If sItm.Selected = True Then
        sSlicerItems = sSlicerItems & sItm.Name & ", "
        ICt = ICt + 1
        End If
        If sItm.HasData = False Then
            ICt = ICt + 1
        End If
    Next
    If Len(sSlicerItems) > 0 Then
        If ICt = cache.SlicerItems.Count Then
            sSlicerItems = "All Items"
        Else
            sSlicerItems = Left(sSlicerItems, Len(sSlicerItems) - 2)
        End If
    Else
        sSlicerItems = "No items selected"
    End If

    GetSlicerItems = sSlicerItems


End Function

first general suggestion,
use F8 and SUB to test your code line by line, and watch window to see variable content
google for "vba debug"
use option explicit mode to check your variable types

with it, you can find whats wrong easily.
eg i found, that cache has wrong type.
You select just one SlicerCache of ThisWorkbook.SlicerCaches collection by ThisWorkbook.SlicerCaches("Slicer_YR_MNTH_CD1") , so it should be:

Dim cache As Excel.SlicerCache 'not SlicerCacheS

now you have your target cache in the variable cache

to be sure that you dont call your function recursive, i suggest to use a temp variable to any operations.
eg Dim sSlicerItems as String

im not sure about right logic of this if/else statements, but anyway your corrected code could look like:

Public Function GetSlicerItems() As String
    Dim sSlicerItems As String

    Dim cache As Excel.SlicerCache
    Set cache = ThisWorkbook.SlicerCaches("Slicer_YR_MNTH_CD1")

    Dim sItm As Excel.SlicerItem
    Dim ICt As Long

    For Each sItm In cache.SlicerItems
        If sItm.Selected = True Then sSlicerItems = sSlicerItems & sItm.Name & ", "
        ICt = ICt + 1
        If sItm.HasData = False Then
            ICt = ICt + 1
        End If
    Next
    If Len(sSlicerItems) > 0 Then
        If ICt = cache.SlicerItems.Count Then
            sSlicerItems = "All Items"
        Else
            sSlicerItems = Left(sSlicerItems, Len(sSlicerItems) - 2)
        End If
    Else
        sSlicerItems = "No items selected"
    End If

    GetSlicerItems = sSlicerItems
End Function

for process something on all slicers, or slicers of only one sheet, use this loop-over-slicers example https://stackoverflow.com/a/20486330/2519073 and .parent property (its a worksheet) of SlicerCache item
maybe you will need more SlicerCache properties for your solution.
check https://msdn.microsoft.com/en-us/library/office/ff822652.aspx

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM