Sub Procedure Timetable

I need to write a sub procedure that takes a schedule (in table form) and puts it into a timetable (the format is given). Attached is the worksheet, just to the right of the timetable is what it needs to look like once the sub prodecure is run.


Thanks for the help, I desperately need it!

there should be at least one blank row between the main data list and the engagement list

in that case try this macro (SEE THE COMMENTS IN CAPITALS WITHIN THE MACRO)

Sub test()
Dim r As Range, c As Range, r1 As Range, t As Date
Dim loc As Range, cfind As Range
Set r = Range(Range("A2"), Range("A2").End(xlDown))
Set r1 = Range("A7")
'r1 IS THE TOP LEFT CELL OF THE ENGAGEMENT LIST
'IF IT IS DIFFERENT CHANGE THE STATEMENT REGARDING r1 ABOVE.

For Each c In r
t = c.Offset(0, 1) & ":00 am"
Set loc = c.Offset(0, 3)
Set r1 = r1.CurrentRegion
Set cfind = r1.Cells.Find(what:=t, lookat:=xlWhole)
cfind.Offset(0, 1) = c
cfind.Offset(0, 2) = loc
Next c
End Sub