VBA to Auto-Arrange & Space Slicers

[cepes]

Hi:
I am looking for VBA that would identify the slicers present on a worksheet, and automatically space them side-to-side, and top-to-bottom, from each other using left/right/top/bottom alignment and using a buffer space. Perhaps also the option to set all to the same width and height.

Thanks.

Charlie Epes

 

[Andrew Poulsom]

Perhaps the code in Post #2 here will get you started:

http://www.mrexcel.com/forum/excel-questions/801579-loop-through-visible-slicers-active-sheet.html

 

[cepes]

Thank you. It's a start.

 

[cepes]

Bastien Mensink from ASAP Utilities (ASAP Utilities for Excel - The popular add-in for Excel users. Easy to use tools that save time and speed up your work in Excel. We also offer a free edition.) gave me some wonderful VBA that organizes slicers nicely.

This is not an advertisement but if truth be told, I recommend ASAP highly.

He said it's shareable!

Option Explicit


Sub AutoArrangeSlicers()

' Places the slicers on the current sheet side by side,
' aligned right next to 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 lNewLeft As Long
Dim lGapWidth As Long
Dim lNewSlicerWidth As Long


lGapWidth = 7 ' 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
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

lNewLeft = lFirstLeftPosition + lFirstWidth + 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.Top = lFirstTopPosition
objSlicer.Left = lNewLeft
lNewLeft = objSlicer.Left + objSlicer.Width + lGapWidth
End If

End If
Next objSlicer
Next objSlicerCache

End Sub