ajjava
01-18-2024, 03:58 PM
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
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