'subscript is out of range'

[Marvin1993]

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