Determining if AutoShapes overlap/occlude in Excel and moving vertically to resolve - vba

Question

I am using some VBA code to create an autoshape and a text box, group them, and move to a vertical and horizontal position based on cell positions.
The code will look at user input to create and group the shape & textbox, and will usually create over 100 shapes, many of which will overlap. Currently, the groups are placed with reference to the top of a row; I want to separate them so that they don't overlap.
I would like to be able to determine if a group overlaps another group, and if so, to move it down 25pts. Given that this check would need to then determine if the new position also overlaps, it's becoming a bit too complicated for my skill level (self-taught beginner.)
I have researched this extensively, and I've come across the following VBA code:
Application.ScreenUpdating = False
Dim wb As Workbook
Set wb = ActiveWorkbook
Dim sh As Worksheet
Set sh = wb.ActiveSheet
Dim s1 As Shape
Dim s2 As Shape Dim CheckOverlap As Boolean
For i = 1 To 10 'sh.Shapes.Count
If i <= sh.Shapes.Count Then
Set s1 = sh.Shapes(i)
CheckOverlap = False
For Each s2 In Worksheets("Plan").Shapes
If s2.Left < (s1.Left + s1.Width) And s2.Top < (s1.Top + s1.Height) Then
CheckOverlap = True
Exit For
End If
Next
If CheckOverlap = True Then
s2.Top = s2.Top + 30
End If
End If
Next
End Sub
I found the basis of the code here:
Hit-Testing and Resolving Occlusion of AutoShapes in Excel
However, I haven't been able to figure it out how to make it check whether overlap occurs vertically as well as horizontally, as well as the multiple-overlap problem. Currently, if I execute that code, it just moves every shape down even irrespective of whether it overlaps.
If someone could help me out I would really appreciate it! This is the hardest part of my project and I'd love to find a solution.
Many thanks for your help

Answer 1

Try the below code. This should align all the charts on the active sheet vertically 25 points apart
Sub MoveShapes()
Dim IncrementTop, TopPosition, LeftPosition, i as Long
IncrementTop = 0
LeftPosition = 'place the desired starting left position here
TopPosition = 'place the desired starting top position here
For i = 1 To ActiveSheet.Shapes.Count
ActiveSheet.Shapes(i).Left = LeftPosition
ActiveSheet.Shapes(i).Top = TopPosition + IncrementTop
IncrementTop = IncrementTop + 25
Next i
End Sub

Answer 2

Found an answer:
Sub MoveShapes1()
Application.ScreenUpdating = False
Dim wb As Workbook
Set wb = ActiveWorkbook
Dim sh As Worksheet
Set sh = wb.ActiveSheet
Dim s1 As Shape
Dim s2 As Shape
Dim CheckOverlap As Boolean
For i = 1 To sh.Shapes.Count
If i <= sh.Shapes.Count Then
Set s1 = sh.Shapes(i)
Search:
CheckOverlap = False
For Each s2 In Worksheets("Plan").Shapes
If s2.ID = s1.ID Then GoTo Suit
If s2.Left <= (s1.Left + s1.Width) And s2.Left >= s1.Left _
And s2.Top <= (s1.Top + s1.Height) And s2.Top >= s1.Top Then
s1.Top = s1.Top + 32
CheckOverlap = True
Exit For
End If
Suit:
Next
If CheckOverlap = True Then GoTo Search
End If
Next
Application.ScreenUpdating = True
End Sub