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