Here is the code:
Option Explicit
Sub sortDates()
Dim rayshapes() As Shape
Dim x As Integer
Dim y As Integer
Dim t As Integer
Const initL As Single = 56.29528
Const initT As Single = 125.3445
Const incL As Single = 122.5583
Const incT As Single = 131.2299
Dim oshp As Shape
Dim osld As Slide
Set osld = ActiveWindow.Selection.SlideRange(1)
ReDim rayshapes(1 To osld.Shapes.Count - 1)
For Each oshp In osld.Shapes
If oshp.Type = msoGroup Then
x = x + 1
Set rayshapes(x) = oshp '<-- This is where I am getting the error for "subscript out of range"
End If 'only groups
Next oshp
Call SortByDate(rayshapes)
t = 0
x = 0
For y = 1 To UBound(rayshapes)
x = x + 1
If x = 8 Then
x = 1
t = t + 1
End If
rayshapes(y).Left = initL + (x - 1) * incL
rayshapes(y).Top = initT + (t * incT)
Next y
End Sub
Sub SortByDate(Arrayin As Variant)
Dim b_Cont As Boolean
Dim rayShape As Shape
Dim lngCount As Long
Dim vSwap As Shape
Dim dateShape As Shape
Dim shp1 As Shape
Dim otr As TextRange
Dim GI As Shape
Dim otr2 As TextRange
Dim thisDate As Date
Dim thisDate2 As Date
Dim ipos As Integer
Do
b_Cont = False
For lngCount = LBound(Arrayin) To UBound(Arrayin) - 1
Set rayShape = Arrayin(lngCount)
Set dateShape = rayShape.GroupItems(rayShape.GroupItems.Count)
Set otr = dateShape.TextFrame.TextRange
Debug.Print otr.Text
ipos = InStr(otr.Paragraphs(2).Text, "–")
If ipos > 0 Then
thisDate = CDate(Left(otr.Paragraphs(2).Text, ipos - 2))
Else
thisDate = CDate(otr.Paragraphs(2).Text)
End If
Set rayShape = Arrayin(lngCount + 1)
Set dateShape = rayShape.GroupItems(rayShape.GroupItems.Count)
Set otr2 = dateShape.TextFrame.TextRange
ipos = InStr(otr2.Paragraphs(2).Text, "–")
If ipos > 0 Then
thisDate2 = CDate(Left(otr2.Paragraphs(2).Text, ipos - 2))
Else
thisDate2 = CDate(otr2.Paragraphs(2).Text)
End If
If thisDate < thisDate2 Then
Set vSwap = Arrayin(lngCount)
Set Arrayin(lngCount) = Arrayin(lngCount + 1)
Set Arrayin(lngCount + 1) = vSwap
b_Cont = True
End If
Next lngCount
Loop Until Not b_Cont
'release objects
Set vSwap = Nothing
Exit Sub
End Sub
'Function getDateHolder(oshp As Shape) As Shape
'Dim G As Long
'If oshp.Type = msoGroup Then
'For G = 1 To oshp.GroupItems.Count
'If oshp.GroupItems(G).HasTextFrame Then
'If oshp.GroupItems(G).TextFrame.TextRange.Paragraphs.Count = 2 Then
'Set getDateHolder = oshp.GroupItems(G)
'Exit Function
'End If
'End If
'Next
'End If
'End Function
Sub sortNames()
Dim rayshapes() As Shape
Dim x As Integer
Dim y As Integer
Dim t As Integer
Const initL As Single = 233.7844
Const initT As Single = 153.2876
Const incL As Single = 84.08623
Const incT As Single = 137.6572
Dim oshp As Shape
Dim osld As Slide
Set osld = ActiveWindow.Selection.SlideRange(1)
ReDim rayshapes(1 To osld.Shapes.Count - 1)
For Each oshp In osld.Shapes
If oshp.Type = msoGroup Then
x = x + 1
Set rayshapes(x) = oshp
End If 'only groups
Next oshp
Call SortByName(rayshapes)
t = 0
x = 0
For y = 1 To UBound(rayshapes)
x = x + 1
If x = 7 Then
x = 1
t = t + 1
End If
rayshapes(y).Left = initL + (x - 1) * incL
rayshapes(y).Top = initT + (t * incT)
Next y
End Sub
Sub SortByName(Arrayin As Variant)
Dim b_Cont As Boolean
Dim rayShape As Shape
Dim rayShape2 As Shape
Dim lngCount As Long
Dim vSwap As Shape
Dim otr As TextRange
Dim otr2 As TextRange
Dim ipos As Integer
Do
b_Cont = False
For lngCount = LBound(Arrayin) To UBound(Arrayin) - 1
Set rayShape = Arrayin(lngCount)
Set rayShape2 = Arrayin(lngCount + 1)
If UCase(rayShape.GroupItems(rayShape.GroupItems.Count).TextFrame.TextRange.Words(2).Text) > UCase(rayShape2.GroupItems(rayShape.GroupItems.Count).TextFrame.TextRange.Words(2).Text) Then
Set vSwap = Arrayin(lngCount)
Set Arrayin(lngCount) = Arrayin(lngCount + 1)
Set Arrayin(lngCount + 1) = vSwap
b_Cont = True
End If
Next lngCount
Loop Until Not b_Cont
'release objects
Set vSwap = Nothing
Exit Sub
End Sub