cradenborg
New Member
- Joined
- Nov 14, 2021
- Messages
- 2
- Office Version
- 365
- Platform
- MacOS
Seen a lot of posts with this question, but no working answers yet.
I have a sheet with a number of pivot tables in Excel, which are controlled by one slicer to set a specific filter. I'm able to abstract the Slicer Items with a VBA function found on the internet:
Now, what I want to do, is to select the same Items in a different Slicer on another worksheet. So I've found another piece of code, that works fine, as long as the array is hardcoded:
I've tried to replace the
with:
which works, as long as only one item is selected in the source slicer. I want to be able to select multiple items as well. How can I fix this? The weird thing is that if a insert a msbBox in the loop to make the right items visible, it gives exactly the right items, which are also available in the slicer.
ps: the pivot tables are on different worksheets as well, but have the same range as source.
Thanx in advance
I have a sheet with a number of pivot tables in Excel, which are controlled by one slicer to set a specific filter. I'm able to abstract the Slicer Items with a VBA function found on the internet:
VBA Code:
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
End If
Next
If Len(GetSelectedSlicerItems) > 0 Then
If lCt = oSc.SlicerItems.Count Then
GetSelectedSlicerItems = "All Items"
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
Now, what I want to do, is to select the same Items in a different Slicer on another worksheet. So I've found another piece of code, that works fine, as long as the array is hardcoded:
VBA Code:
Dim slr As Slicer
Dim sc As SlicerCache
Dim si As SlicerItem
Dim i As Long
Dim vItem As Variant
Dim vSelection As Variant
Set sc = ActiveWorkbook.SlicerCaches("Slicer_Afdeling")
'Set sc = slr.SlicerCache
vSelection = Array("DevOPs", "Functional Support", "Technical Support")
For Each pt In sc.PivotTables
pt.ManualUpdate = True 'Stops PivotTable from refreshing after each PivotItem is changed
Next pt
With sc
'At least one item must remain visible in the Slicer at all times, so make the first
'item visible, and at the end of the routine, check if it actually *should* be visible
.SlicerItems(1).Selected = True
'Hide any other items that aren't already hidden.
'Note that it is far quicker to check the status than to change it.
' So only hide each item if it isn't already hidden
For i = 2 To .SlicerItems.Count
If .SlicerItems(i).Selected Then .SlicerItems(i).Selected = False
Next i
'Make the PivotItems of interest visible
On Error Resume Next 'In case one of the items isn't found
For Each vItem In vSelection
.SlicerItems(vItem).Selected = True
Next vItem
On Error GoTo 0
'Hide the first PivotItem, unless it is one of the countries of interest
On Error Resume Next
If InStr(UCase(Join(vSelection, "|")), UCase(.SlicerItems(1).Name)) = 0 Then .SlicerItems(1).Selected = False
If Err.Number <> 0 Then
.ClearAllFilters
MsgBox Title:="No Items Found", Prompt:="None of the desired items was found in the Slicer, so I have cleared the filter"
End If
On Error GoTo 0
End With
For Each pt In sc.PivotTables
pt.ManualUpdate = False
Next pt
End Sub
I've tried to replace the
VBA Code:
vSelection = Array("DevOPs", "Functional Support", "Technical Support")
VBA Code:
str = GetSelectedSlicerItems("Slicer_Afdeling1") vSelection = Split(str, ",")
which works, as long as only one item is selected in the source slicer. I want to be able to select multiple items as well. How can I fix this? The weird thing is that if a insert a msbBox in the loop to make the right items visible, it gives exactly the right items, which are also available in the slicer.
ps: the pivot tables are on different worksheets as well, but have the same range as source.
Thanx in advance