S: Select all slicers on a sheet and arrange them vertically IN ALPHA ORDER by NAME?

[ajjava]

Hoping for some assistance on this, as my searches thus far have been fruitless....

I have a macro that arranges all the slicers on a worksheet in a vertical column, based on the left-most slicer (I keep seeing the same macro popping up all around the web, so it's hard to say who the original author is).

It's working as intended.

The icing on the cake would be if there was a way to align all the slicers in ALPHA ORDER, by either source name or formula name or caption.

I suspect it's not as straightforward as it seems on the surface, which accounts for my lack of search results.

Any suggestions would be greatly appreciated!



Sub AutoArrangeSlicersVERTICAL()

' Places the slicers on the current sheet in a vertical column,
' aligned right UNDER the upper left first slicer


Dim objSlicerCache As SlicerCache
Dim objSlicer As Slicer
Dim objSlicerMostLeft As Slicer


Dim lFirstTopPosition As Long
Dim lFirstLeftPosition As Long
Dim lFirstWidth As Long
Dim lFirstHeight As Long


Dim lNewLeft As Long
Dim lNewTop As Long


Dim lGapWidth As Long
Dim lNewSlicerWidth As Long




lGapWidth = 5 ' set the gap width between the slicers
lNewSlicerWidth = 0 ' set to a size > 0 to set the same width to all slicers
' set to 0 to keep the original width of the slicers




For Each objSlicerCache In ActiveWorkbook.SlicerCaches

For Each objSlicer In objSlicerCache.Slicers

If objSlicer.Shape.TopLeftCell.Worksheet.Name = ActiveSheet.Name Then

If lNewSlicerWidth > 0 Then
' set the new same width to all slicers
objSlicer.Width = lNewSlicerWidth
End If

If objSlicerMostLeft Is Nothing Then

Set objSlicerMostLeft = objSlicer
lFirstTopPosition = objSlicer.Top
lFirstLeftPosition = objSlicer.Left
lFirstWidth = objSlicer.Width

Else
' verify
If lFirstLeftPosition > objSlicer.Left Then
' we've got a new one to the left, update info
Set objSlicerMostLeft = objSlicer
lFirstTopPosition = objSlicer.Top
lFirstLeftPosition = objSlicer.Left
lFirstWidth = objSlicer.Width
lFirstHeight = objSlicer.Height
Else
' skip
End If
End If
End If
Next objSlicer
Next objSlicerCache


' Okay, we've got the most left position.
' Now, loop through all slicers again and position them right next to the first one
' with a small gap




lNewTop = lFirstTopPosition + lFirstHeight + lGapWidth


For Each objSlicerCache In ActiveWorkbook.SlicerCaches
For Each objSlicer In objSlicerCache.Slicers
If objSlicer.Shape.TopLeftCell.Worksheet.Name = ActiveSheet.Name Then


If objSlicer.Name = objSlicerMostLeft.Name Then
' skip
Else
' process
objSlicer.Left = lFirstLeftPosition
objSlicer.Top = lNewTop
lNewTop = objSlicer.Top + objSlicer.Height + lGapWidth
End If


End If
Next objSlicer
Next objSlicerCache


End Sub

[Aussiebear]

Have a look here as Mynda shows how to set up a custom list for sorting slicers. https://www.youtube.com/watch?v=JLormBlUF_w

[ajjava]

Thanks, but that's for custom sorting the slicer items. I'm hoping for a way to sort the slicers, themselves.

[georgiboy]

Are you able to supply a sample workbook with slicers already in place?
You may need to remove sensitive data.
The code you have supplied above should be in the workbook and working.

I am not stating that it can be done but you will be more likely to get help if we don't need to take the time to create the workbook.

[georgiboy]

Also, which version of Excel does this need to work in, 2016, 2019, 2021, 365?

[Aussiebear]

Thanks, but that's for custom sorting the slicer items. I'm hoping for a way to sort the slicers, themselves. I'm reasonably certain that Mynda talks about how to create a custom list for the slicers in the early part of the video.

[p45cal]

Try:
Sub AutoArrangeSlicersVERTICAL()
' Places the slicers on the current sheet in a vertical column,
' aligned LEFT with the leftmost slicer, starting from the top of the highest slicer .
Dim objSlicerCache As SlicerCache
Dim objSlicer As Slicer
Dim mySlicers, HighestTop, LeftMost, ArrList, Key
Dim lNewTop
Dim lGapWidth
Dim lNewSlicerWidth
Set mySlicers = CreateObject("Scripting.Dictionary")

lGapWidth = 5 ' set the gap width between the slicers
lNewSlicerWidth = 0 ' set to a size > 0 to set the same width to all slicers
HighestTop = 9E+99: LeftMost = 9E+99
' set to 0 to keep the original width of the slicers
For Each objSlicerCache In ActiveWorkbook.SlicerCaches
For Each objSlicer In objSlicerCache.Slicers
If objSlicer.Shape.TopLeftCell.Worksheet.Name = ActiveSheet.Name Then
mySlicers.Add objSlicer.Caption, objSlicer 'you might want to use .Caption instead of .Name here
If lNewSlicerWidth > 0 Then
' set the new same width to all slicers
objSlicer.Width = lNewSlicerWidth
End If
HighestTop = Application.Min(HighestTop, objSlicer.Top)
LeftMost = Application.Min(LeftMost, objSlicer.Left)
End If
Next objSlicer
Next objSlicerCache
lNewTop = HighestTop
' Okay, we've got the most left and highest positions and all the slicers we're going to reposition in the mySlicers dictionary.
' Now, loop through all slicers again and position them right next to the first one
' with a small gap
'Sort the mySlicer keys:
Set ArrList = CreateObject("System.Collections.ArrayList") 'for sorting
For Each Key In mySlicers
ArrList.Add Key
Next Key
ArrList.Sort
For Each Key In ArrList
With mySlicers(Key)
.Left = LeftMost
.Top = lNewTop
lNewTop = .Top + .Height + lGapWidth
End With
Next Key
End Sub