Home |
Search |
Today's Posts |
#1
![]() |
|||
|
|||
![]()
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? |
#2
![]() |
|||
|
|||
![]()
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, Befo=jCtr myNames.Add Swap2, Befo=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 Befo=.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 |
#3
![]() |
|||
|
|||
![]()
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_pa pabear_misc.xls (Easier to see Dave's magic at work <g) -- Rgds Max xl 97 --- Singapore, GMT+8 xdemechanik http://savefile.com/projects/236895 -- |
#4
![]() |
|||
|
|||
![]()
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_pa pabear_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 |
#5
![]() |
|||
|
|||
![]()
"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 -- |
#6
![]() |
|||
|
|||
![]()
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_p apabear_misc.xls (Easier to see Dave's magic at work <g) -- Rgds Max xl 97 --- Singapore, GMT+8 xdemechanik http://savefile.com/projects/236895 -- |
#7
![]() |
|||
|
|||
![]()
You're welcome, Roger !
-- Rgds Max xl 97 --- Singapore, GMT+8 xdemechanik http://savefile.com/projects/236895 -- "Roger Govier" wrote in message ... 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 |
#8
![]() |
|||
|
|||
![]()
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_p apabear_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 |
#9
![]() |
|||
|
|||
![]()
Another link to the demo file:
http://www.savefile.com/files/2705901 Schedule_Generation_Subroutine_by_Dave_Peterson_pa pabear_misc.xls -- Rgds Max xl 97 --- Singapore, GMT+8 xdemechanik http://savefile.com/projects/236895 -- |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Create a report with selected rows based on the content in a cell | New Users to Excel | |||
Create Total based on lookup value | Excel Worksheet Functions | |||
how to create and use a new spreadsheet based on a template | Excel Discussion (Misc queries) | |||
How to create a calculated field formula based on Pivot Table resu | Excel Discussion (Misc queries) | |||
Create a total based on multiple conditions is not giving correct. | Excel Worksheet Functions |