```
Option Base 1
Option Explicit
Dim week_array(7) As String
Const row_index As String = 1 'change this to reflect row number where days go across from
Sub splitweeks()
Dim col_index As Integer, wnum As Integer
col_index = 2 'change this to reflect column number where *SECOND* day begins
week_array(1) = "Saturday": week_array(2) = "Sunday": week_array(3) = "Monday"
week_array(4) = "Tuesday": week_array(5) = "Wednesday": week_array(6) = "Thursday": week_array(7) = "Friday"
wnum = 1
'Cells(row_index, (col_index-1)) = "Week 1"
Do While Cells(row_index, col_index) <> ""
If get_week_index(Cells(row_index, (col_index - 1))) > 1 And get_week_index(Cells(row_index, (col_index))) < get_week_index(Cells(row_index, (col_index - 1))) Then
Cells(row_index, col_index).Select
Selection.EntireColumn.Insert
Cells(row_index, col_index) = "Week " & wnum
wnum = wnum + 1
col_index = col_index + 1
End If
col_index = col_index + 1
Loop
End Sub
Function get_week_index(day As String) As Integer
Dim x As Integer
x = 1
Do While x < (UBound(week_array) + 1)
If week_array(x) = day Then
get_week_index = x
Exit Do
End If
x = x + 1
Loop
If x = UBound(week_array) + 1 Then
get_week_index = -1
End If
End Function
```