```
Option Explicit
Option Compare Text
Public Sub ParseData()
Dim LastRow As Long
Dim i As Long
Dim Counter As Long
Dim Aint As Integer
Dim MyString() As String
Application.StatusBar = "Working hard"
With Sheets(1).UsedRange
LastRow = .Rows(.Rows.Count).Row
End With
If LastRow < 1 Then 'empty sheet
MsgBox ("Sheet is empty")
Exit Sub
End If
With Sheets(2)
Counter = 0
For i = 1 To LastRow
Aint = InStr(1, Sheets(1).Cells(i, 1), "Summary Data For")
If Aint > 0 Then
Counter = Counter + 1
MyString = Split(Sheets(1).Cells(i, 1), ":")
.Cells(1, 1) = MyString(1)
.Cells(1, Counter + 1) = MyString(2)
End If
Aint = InStr(1, Sheets(1).Cells(i, 1), "Break ")
If Aint > 0 Then
MyString = Split(Sheets(1).Cells(i, 1), " ")
.Cells(2, 1) = MyString(0)
.Cells(2, Counter + 1) = MyString(1)
End If
Aint = InStr(1, Sheets(1).Cells(i, 1), "Coaching ")
If Aint > 0 Then
MyString = Split(Sheets(1).Cells(i, 1), " ")
.Cells(3, 1) = MyString(0)
.Cells(3, Counter + 1) = MyString(1)
End If
Aint = InStr(1, Sheets(1).Cells(i, 1), "Extra time ")
If Aint > 0 Then
MyString = Split(Sheets(1).Cells(i, 1), " ")
.Cells(4, 1) = MyString(1)
.Cells(4, Counter + 1) = MyString(2)
End If
Aint = InStr(1, Sheets(1).Cells(i, 1), "Late ")
If Aint > 0 Then
MyString = Split(Sheets(1).Cells(i, 1), " ")
.Cells(5, 1) = MyString(0)
.Cells(5, Counter + 1) = MyString(1)
End If
Aint = InStr(1, Sheets(1).Cells(i, 1), "Lunch ")
If Aint > 0 Then
MyString = Split(Sheets(1).Cells(i, 1), " ")
.Cells(6, 1) = MyString(0)
.Cells(6, Counter + 1) = MyString(1)
End If
Aint = InStr(1, Sheets(1).Cells(i, 1), "Sick ")
If Aint > 0 Then
MyString = Split(Sheets(1).Cells(i, 1), " ")
.Cells(7, 1) = MyString(0)
.Cells(7, Counter + 1) = MyString(1)
End If
Aint = InStr(1, Sheets(1).Cells(i, 1), "'Vacation ")
If Aint > 0 Then
MyString = Split(Sheets(1).Cells(i, 1), " ")
.Cells(8, 1) = MyString(0)
.Cells(8, Counter + 1) = MyString(1)
End If
Next i
End With
Application.StatusBar = "I am done Working hard --- start next task"
End Sub
```