VBA to output MANUALLY slicer-selected items ONLY, in a specified cell?

[ajjava]

I've gotten SOOO close to a solution, but something invariably falls apart in practice (and I don't think it's because this is a complicated procedure...instead, it's because I know enough VBA to speak (somewhat) intelligently about it, and to write basic procedures, but I fall apart when it comes to writing logical and efficient procedures that require many loops and logical tests).

Use case:

• One pivot table (non-data model pivot)
• Many slicers
• Desired output: All manually-selected slicer items (to be used in the title of related charts)
  • Output on a specified sheet
  • Can be in a list or in a comma-delimited string
• Criteria:
  • Only return values from slicers that have been manually filtered (so those with the red x next to the filter icon)
    • IGNORE any slicers that have been filtered/limited only as a result of another manually-filtered slicer
  • IGNORE the filtering out of '(blank)'items, even though they may be filtered manually by the user
    • i.e. If the only item that's been filtered out is '(blank)', treat that slicer as NOT FILTERED and don't return any output
  • Loop through all slicers dynamically, no specific slicer names used in the script

I would post my cobbled-together, unreliable code, but I fear that it will just unnecessarily "lead the witness" and complicate matters.

Any help would be immensely appreciated, as I've burned HOURS on getting this to work.

Here is a visual:

 

[ajjava]

And one more SUPER annoying thing that's been happening, both with my feeble coding attempts and with your procedure - values from the prior data source are remaining in some of the slicers - no matter what I've tried to stop it. The items highlighted in red, within the red outlined boxes, are all from the previous data source.
I've tried:

1. Clearing the slicer cache
2. Changing the settings in 'Slicer Settings' (toggled 'hide items with no data', 'show items deleted from the data source', etc.)

View attachment 100930

Any ideas on suppressing that behavior?

On further investigation, I think this may have to do with the fact that the data source is being handled by PowerQuery, via an Append query.
Does that sound plausible (asking all forum members, not just poor Jeffrey)

 

[Jeffrey Mahoney]

Ok, just back into this. Here's what the code can and cannot do. There is only one option for getting the slicer item "Selected".
* If a slicer has items selected manually, the code only returns those items
* If a slicer has no manually selected items, they are all selected, regardless if the item is greyed out (not visible in the pivot) or colored (visible in the pivot)

 

[Jeffrey Mahoney]

I don't know what is going on with the slicer name claim status. The code is reading the name provided by the slicer.

 

[ajjava]

I don't know what is going on with the slicer name claim status. The code is reading the name provided by the slicer.

Yup, sorry if I was unclear. I was trying to point out to you that it had a different name in the caption than the "technical" name of the slicer object. The code is handling it fine.
I didn't have a chance to do more with the code today, but I will hopefully be back at it tomorrow.
Thanks again!

 

[Jeffrey Mahoney]

I was trying to alter the code so we could compare if the full list of items.
* if Full List = Partial List then no manually selected items

 

[Jeffrey Mahoney]

This seems to be working more like you wanted. Let me know

Sub GetSelSlicerNames()
  Dim Slcr As SlicerCache
  Dim SI As SlicerItem
  Dim SINames As String
  Dim SIName As String
  Dim BlankSel As Boolean
  Dim AllSINames As String
  Dim X As Long

  For Each Slcr In ActiveWorkbook.SlicerCaches
    Range("J1").Offset(X, 0).Value = Slcr.Name
    For Each SI In Slcr.SlicerItems                             'ActiveWorkbook.SlicerCaches("Slicer_PO")
      SIName = SI.Name
      If SIName <> "(blank)" Then
        If AllSINames <> "" Then
            AllSINames = AllSINames & ", " & SIName
          Else
            AllSINames = SIName
        End If
      
        If SI.Selected = True Then
          If SINames <> "" Then
              SINames = SINames & ", " & SIName
            Else
              SINames = SIName
            End If
          End If
        End If
    Next SI
    If SINames = AllSINames Then
      Range("K1").Offset(X, 0) = ""
    Else
      Range("K1").Offset(X, 0) = SINames
    End If
    X = X + 1
    SINames = ""
    AllSINames = ""
    BlankSel = False
  Next Slcr
    
End Sub