Sub ShapeRange_Sort() Dim d As Document Dim sr As New ShapeRange 'Holds all the text shapes / numbers Dim s As Shape, s1 As Shape, s2 As Shape Dim y As Integer 'Holds the y position value of the rectangle Dim x As Integer 'Holds the x position value of the rectangle Dim i As Integer 'Holds the brick counter Set d = CreateDocument 'Create Bricks For y = 1 To 9 For x = 1 To 6 i = i + 1 Set s1 = d.ActiveLayer.CreateRectangle2(x, y, 1, 0.5) 'Creates a Rectangle Shape Set s2 = d.ActiveLayer.CreateArtisticText(0, 0, i) 'Creates a Number for the Brick Shape s2.AlignToShape cdrAlignVCenter, s1 'Aligns the Text Vertically to the rectangle s2.AlignToShape cdrAlignHCenter, s1 'Aligns the Text Horizontally to the rectangle sr.Add s2 Next x Next y For y = 1 To 9 For x = 1 To 6 i = i + 1 Set s1 = d.ActiveLayer.CreateRectangle2(x, y + 0.5, 1, 0.5) Set s2 = d.ActiveLayer.CreateArtisticText(0, 0, i) s2.AlignToShape cdrAlignVCenter, s1 s2.AlignToShape cdrAlignHCenter, s1 sr.Add s2 Next x Next y 'Sort the numbers from the upper left to the lower right '(going right and then down). To do this, give the highest value 'to the upper-left shape by multiplying its top position by 100 'and subtracting its left position. 'Example Shape 1 has a top value of 10 and a left value of 1 so ... 'Shape 1 (Upper Left Shape) -> 10 X 100 - 1 = 999 'Shape 2 (to the right of Shape 1) -> 10 x 100 - 2 = 998 'Bottom right Shape would be 1.5 x 100 - 6 = 144 MsgBox "Click OK to Sort the Bricks", vbOKOnly, "ShapeRange.Sort Example" sr.Sort " @shape1.Top * 100 - @shape1.Left > @shape2.Top * 100 - @shape2.Left" i = 0 For Each s In sr.Shapes i = i + 1 s.Text.Story.Text = i Next s End Sub