If you have shapes on a sheet, the following code will put it in a N row, 4 column grid.
(Adjust the HGap and VGap constants to your taste.)
Adjust the LeaveBlank variable will leave blank places.
LeaveBlank = 0 will put the first shape in the top left corner of the grid, row 1 column 1
LeaveBlank = 1 will put the top left existing shape in row 1 column 2
You can either run it on existing sheet with LeaveBlank = 1 and put your new shape in the space left in row 1 column 1.
Or you can put your new shape on the existing sheet with the New shape as the top left shape on the sheet and then run the program with LeaveBlank = 0.
This will ignore controls on the sheet from the Forms menu, to allow you to run it by a button.
Code:
Sub test()
Dim oneShape As Shape
Dim minTop As Single, minLeft As Single
Dim maxHeight As Single, maxWidth As Single
Dim hIndex As Long, vIndex As Long
Dim LeaveBlank As Long
Dim currShapes As Collection
Dim i As Long
Dim flag As Boolean
Const HGap As Single = 30: Rem adjust
Const VGap As Single = 10: Rem adjust
LeaveBlank = 1: Rem adjust
minTop = 9e+15: minLeft = 9e+15
For Each oneShape In ActiveSheet.Shapes
If oneShape.Type <> msoFormControl Then
With oneShape
If .Top < minTop Then minTop = .Top
If .Left < minLeft Then minLeft = .Left
If maxHeight < .Height Then maxHeight = .Height
If maxWidth < .Width Then maxWidth = .Width
End With
End If
Next oneShape
For Each oneShape In ActiveSheet.Shapes
If oneShape.Type <> msoFormControl Then
With oneShape
.Top = minTop + Int((.Top - minTop) / maxHeight) * (maxHeight + VGap)
.Left = minLeft + Int((.Left - minLeft) / maxWidth) * (maxWidth + HGap)
End With
End If
Next oneShape
Application.ScreenUpdating = True
Set currShapes = New Collection
For Each oneShape In ActiveSheet.Shapes
If oneShape.Type <> msoFormControl Then
flag = False
For i = 1 To currShapes.Count
If oneShape.Top < currShapes(i).Top Then
currShapes.Add Item:=oneShape, before:=i
flag = True
Exit For
ElseIf oneShape.Top = currShapes(i).Top Then
If oneShape.Left < currShapes(i).Left Then
currShapes.Add Item:=oneShape, before:=i
flag = True
Exit For
End If
End If
Next i
If Not flag Then currShapes.Add Item:=oneShape
End If
Next oneShape
hIndex = LeaveBlank: vIndex = 0
For Each oneShape In currShapes
oneShape.Top = minTop + vIndex * (maxHeight + VGap)
oneShape.Left = minLeft + hIndex * (maxWidth + HGap)
hIndex = hIndex + 1
If 3 < hIndex Then
hIndex = 0
vIndex = vIndex + 1
End If
Next oneShape
End Sub
Note that this does not know "old" or "new", it snaps existing shapes to a grid and then shift those shapes within the grid.
If the exisitign shapes are "newest in R1 C1, next newest in R1 C2, next newest in R1 C3,..." it will maintain that new>>old order in the shifted grid.
