Create patient schedule based on master therapist schedule

I have a friend who spends hours on scheduling and would like to streamline
things. She is a therapist who works with other therapists and their
patients. This is only for their Saturday schedule. They use a dry erase
board and magnets M-F, but the Saturday schedule needs to be different. This
is what the master sheet looks like:
OT1 OT2 PT1 PT2 Rec. ST1
7:00
7:30 Ann V. Carminia
8:00 Estela
8:30 Catherine Carminia
9:00 Renato Carminia
9:30 PW/Brk
10:00 Catherine
10:30 Estela Carminia
11:00 Chris
11:30 Chris
12:00
12:30 Ann V.
1:00 PW/Brk
1:30 Renato
2:00 PW/Brk
2:30 Carminia Carminia
3:00 PW/Brk
3:30 Floyd
4:00
There are usually 3 OT's, 3 PT's 3 ST's and a Tech and an Extra help person.
The master schedule is for each therapist (Occupational, Physical and
Speech).

What they want to be able to do is give the nurses each of the patients
schedules for the day. The names going down the time slots are the patients.
Normally each column would be filled with patient names, but for this
example I'm just using Carmenia. From this master list they want to be able
to generate a schedule for each patient. So, Carmenia's schedule would look
like this:
Carminia's Schedule:
7:30 - 8:00 ST
8:30 - 9:30 Rec
10:30 - 11:00 ST
2:30 - 3:00 PT/OT
Notice how the patient schedule only shows either OT, PT, ST or Rec. They
don't need to know if it's OT1, OT2 or OT3. If it's OT1, 2 or 3 they just
need to know it's OT. And if Carmenia's name appears in an OT and a PT cell
for the same time then it's a co-treatment, thus PT/OT from 2:30 to 3:00.

They'd like to generate this kind of schedule for each of their 20 or so
patients. I'm hoping there is a way to do this. Maybe Excel could create a
new sheet for each patient within the master sheet. Does anyone know how I
can make this happen?

I _think_ that this does what you want.

Option Explicit
Sub testme02()

Dim CurWks As Worksheet
Dim RptWks As Worksheet

Dim LastRow As Long
Dim LastCol As Long
Dim oRow As Long

Dim TableRng As Range
Dim myCell As Range
Dim myRow As Range
Dim myNames As Collection

Dim iCtr As Long
Dim jCtr As Long
Dim Swap1 As Variant
Dim Swap2 As Variant

Dim myCateHeader As String
Dim myCateStr As String
Dim myTimeStr As String
Dim NumInRow As Long

Application.ScreenUpdating = False

Set CurWks = Worksheets("Sheet1")
Set RptWks = Worksheets.Add
Set myNames = New Collection

With CurWks
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
Set TableRng = .Range("b2", .Cells(LastRow, LastCol))
End With

On Error Resume Next
For Each myCell In TableRng.Cells
If Trim(myCell.Value) = "" Then
'do nothing
Else
myNames.Add Item:=myCell.Value, key:=CStr(myCell.Value)
End If
Next myCell

For iCtr = 1 To myNames.Count - 1
For jCtr = iCtr + 1 To myNames.Count
If myNames(iCtr) > myNames(jCtr) Then
Swap1 = myNames(iCtr)
Swap2 = myNames(jCtr)
myNames.Add Swap1, Before:=jCtr
myNames.Add Swap2, Before:=iCtr
myNames.Remove iCtr + 1
myNames.Remove jCtr + 1
End If
Next jCtr
Next iCtr

oRow = -1
For iCtr = 1 To myNames.Count
oRow = oRow + 2
With RptWks.Cells(oRow, "A")
If oRow > 1 Then
.Parent.HPageBreaks.Add Before:=.Cells
End If
.Value = myNames(iCtr) & " Schedule:"
.Font.Bold = True
End With
oRow = oRow + 1

For Each myRow In TableRng.Rows
NumInRow = Application.CountIf(myRow, myNames(iCtr))
If NumInRow > 0 Then
myCateStr = ""
myTimeStr _
= Format(CurWks.Cells(myRow.Row, "A").Value, "hh:mm") _
& "-" & Format(CurWks.Cells(myRow.Row, "A").Value _
+ TimeSerial(0, 30, 0), "hh:mm")
For Each myCell In myRow.Cells
If myCell.Value = myNames(iCtr) Then
myCateHeader = CurWks.Cells(1, myCell.Column).Value
If IsNumeric(Right(myCateHeader, 1)) Then
myCateHeader _
= Left(myCateHeader, Len(myCateHeader) - 1)
End If
myCateStr = myCateStr & "/" & myCateHeader
End If
Next myCell
If myCateStr <> "" Then
myCateStr = Mid(myCateStr, 2)
End If
RptWks.Cells(oRow, "A").Value = myTimeStr
RptWks.Cells(oRow, "B").Value = myCateStr
oRow = oRow + 1
End If
Next myRow
Next iCtr

RptWks.UsedRange.Columns.AutoFit

Application.ScreenUpdating = True

End Sub

If you're new to macros, you may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm

PapaBear wrote:
>
> I have a friend who spends hours on scheduling and would like to streamline
> things. She is a therapist who works with other therapists and their
> patients. This is only for their Saturday schedule. They use a dry erase
> board and magnets M-F, but the Saturday schedule needs to be different. This
> is what the master sheet looks like:
> OT1 OT2 PT1 PT2 Rec. ST1
> 7:00
> 7:30 Ann V. Carminia
> 8:00 Estela
> 8:30 Catherine Carminia
> 9:00 Renato Carminia
> 9:30 PW/Brk
> 10:00 Catherine
> 10:30 Estela Carminia
> 11:00 Chris
> 11:30 Chris
> 12:00
> 12:30 Ann V.
> 1:00 PW/Brk
> 1:30 Renato
> 2:00 PW/Brk
> 2:30 Carminia Carminia
> 3:00 PW/Brk
> 3:30 Floyd
> 4:00
> There are usually 3 OT's, 3 PT's 3 ST's and a Tech and an Extra help person.
> The master schedule is for each therapist (Occupational, Physical and
> Speech).
>
> What they want to be able to do is give the nurses each of the patients
> schedules for the day. The names going down the time slots are the patients.
> Normally each column would be filled with patient names, but for this
> example I'm just using Carmenia. From this master list they want to be able
> to generate a schedule for each patient. So, Carmenia's schedule would look
> like this:
> Carminia's Schedule:
> 7:30 - 8:00 ST
> 8:30 - 9:30 Rec
> 10:30 - 11:00 ST
> 2:30 - 3:00 PT/OT
> Notice how the patient schedule only shows either OT, PT, ST or Rec. They
> don't need to know if it's OT1, OT2 or OT3. If it's OT1, 2 or 3 they just
> need to know it's OT. And if Carmenia's name appears in an OT and a PT cell
> for the same time then it's a co-treatment, thus PT/OT from 2:30 to 3:00.
>
> They'd like to generate this kind of schedule for each of their 20 or so
> patients. I'm hoping there is a way to do this. Maybe Excel could create a
> new sheet for each patient within the master sheet. Does anyone know how I
> can make this happen?

--

Dave Peterson

Thought that was a great routine, Dave !

And for the OP / those interested ..
here's a demo file with the OP's set-up & Dave P's sub implemented:
http://cjoint.com/?klfBtLMmYZ
Schedule_Generation_Subroutine_by_Dave_Peterson_papabear_misc.xls
(Easier to see Dave's magic at work <g>)
--
Rgds
Max
xl 97
---
Singapore, GMT+8
xdemechanik
http://savefile.com/projects/236895
--

I wonder if Papabear will be back???

Max wrote:
>
> Thought that was a great routine, Dave !
>
> And for the OP / those interested ..
> here's a demo file with the OP's set-up & Dave P's sub implemented:
> http://cjoint.com/?klfBtLMmYZ
> Schedule_Generation_Subroutine_by_Dave_Peterson_papabear_misc.xls
> (Easier to see Dave's magic at work <g>)
> --
> Rgds
> Max
> xl 97
> ---
> Singapore, GMT+8
> xdemechanik
> http://savefile.com/projects/236895
> --

--

Dave Peterson

"Dave Peterson" wrote:
> I wonder if Papabear will be back???
I dunno, but the honey's all packed and
ready for him to bring home ! <g>
--
Rgds
Max
xl 97
---
Singapore, GMT+8
xdemechanik
http://savefile.com/projects/236895
--

Hi Max

Thanks for taking the trouble to set that up, and post it for all of us
to see.
I watched the thread, but had no idea where to start.
When I saw Dave's code I naturally assumed it work!!!!
Nice one Dave!

Regards

Roger Govier



Max wrote:

>Thought that was a great routine, Dave !
>
>And for the OP / those interested ..
>here's a demo file with the OP's set-up & Dave P's sub implemented:
>http://cjoint.com/?klfBtLMmYZ
>Schedule_Generation_Subroutine_by_Dave_Peterson_papabear_misc.xls
>(Easier to see Dave's magic at work <g>)
>--
>Rgds
>Max
>xl 97
>---
>Singapore, GMT+8
>xdemechanik
>http://savefile.com/projects/236895
>--
>
>
>
>

You're welcome, Roger !
--
Rgds
Max
xl 97
---
Singapore, GMT+8
xdemechanik
http://savefile.com/projects/236895
--
"Roger Govier" <roger@nospamtechnology4u.co.uk> wrote in message
news:434B7A0C.1080702@nospamtechnology4u.co.uk...
> Hi Max
>
> Thanks for taking the trouble to set that up, and post it for all of us
> to see.
> I watched the thread, but had no idea where to start.
> When I saw Dave's code I naturally assumed it work!!!!
> Nice one Dave!
>
> Regards
>
> Roger Govier

Well, it worked in Max's and my tests. But the proof of the pudding is in the
taste.

Roger Govier wrote:
>
> Hi Max
>
> Thanks for taking the trouble to set that up, and post it for all of us
> to see.
> I watched the thread, but had no idea where to start.
> When I saw Dave's code I naturally assumed it work!!!!
> Nice one Dave!
>
> Regards
>
> Roger Govier
>
> Max wrote:
>
> >Thought that was a great routine, Dave !
> >
> >And for the OP / those interested ..
> >here's a demo file with the OP's set-up & Dave P's sub implemented:
> >http://cjoint.com/?klfBtLMmYZ
> >Schedule_Generation_Subroutine_by_Dave_Peterson_papabear_misc.xls
> >(Easier to see Dave's magic at work <g>)
> >--
> >Rgds
> >Max
> >xl 97
> >---
> >Singapore, GMT+8
> >xdemechanik
> >http://savefile.com/projects/236895
> >--
> >
> >
> >
> >

--

Dave Peterson

Another link to the demo file:
http://www.savefile.com/files/2705901
Schedule_Generation_Subroutine_by_Dave_Peterson_papabear_misc.xls
--
Rgds
Max
xl 97
---
Singapore, GMT+8
xdemechanik
http://savefile.com/projects/236895
--