Shift Roster on Excel, pls help
in [Programming]
|
Prev: Import selected worksheet from another workbook
Next: Error: Microsoft ODBC Driver Manager Data Source name not found
From: beancurd on 27 Feb 2010 11:36 Who can help me to auto generate roster on excel, it is very complicate...pls help... 1) bill date (5, 7, 11, 14, 17, 21, 25 and end of month) need to 6 day 3 night, but if Saturday, Sunday or Public Holiday need to 2 day 2 night 2) non bill date only need to 6 day 2 night staff 3) non bill date if Saturday, Sunday or Public Holiday need to 2 day and 1 night 4) if on Friday, need to 5 day 3 night 5) on shift staff, each staff need to have 1 double off on roster and one Saturday off, two Sun off another 2 off on weekend, they cannot continuous more then 5 days work and cannot last day on NIGHT shift, next day on DAY shift 6) if Staff A on night duty, and that night only 2 staff or 1 staff, it may be additional add 1 more staff on night shift too 10 Staff in a Team, 4 staff is not on shift, that mean only on duty at day and day off on Sat, Sun and Public Holiday; another 6 staff need to on shift duty, how can I to be fair to automatically generate a roster? A roster basic on 4 week, start on Monday. More information, all staff must be on duty job (except one of department head, he is not on shift duty, only duty at day and day off on Sat, Sun and Public Holiday) A = day N = night A/R = duty 1 A/E = duty 2 A/M = duty 3 (except on Sat, Sun and Public Holiday)
From: joel on 27 Feb 2010 23:40 I started the code below but need more info to continue. I don't understadn the Term "Shift staff". Also, is there a minimum number of hours each employee need to work? I don't understand the supervisors shcedule. Does the 10 employees include the supervisor or is the supervisor in addition to the 10 other employees. Also how many supervisors are there. the code requeire the workbook to have at least on sheet Names "Holidays". On this sheet put the word Holiday in cell A1. Then list all the holidays in a date format starting in cell A2. The code will delete all sheets except the sheet named Holidays and create a 12 month clendar with the number of employees needed each shift. I'm thinking of rotating the employees but don't have all the requirements. Usually you would have an employee work 5/6 days one shift then have two days off and going to next shift. VBA Code: -------------------- Const NumberOfStaff = 10 Const FirstShiftRow = 6 Const SkipRows = 3 Sub GenerateCalendar() 'set up rows on worksheet where to start each shift SecondShiftRow = FirstShiftRow + NumberOfStaff + SkipRows 'code assigns Employees in Order EmployeeCount = 1 'Get holiday range With Sheets("Holidays") LastRow = .Range("A" & Rows.Count).End(xlUp).Row Set HolidayRange = .Range("A2:A" & LastRow) End With MyYearStr = InputBox("Enter Year : ") MyYear = Val(MyYearStr) 'Delete All sheets except Holiday Application.DisplayAlerts = False For ShtCount = Sheets.Count To 1 Step -1 If Sheets(ShtCount).Name <> "Holidays" Then Sheets(ShtCount).Delete End If Next ShtCount Application.DisplayAlerts = True For MonthCount = 1 To 12 'start calendar on column 2 ColCount = 2 'Get LastDay of the Month as a date 'the last day of the month is the day before 'the 1st day of the next month LastDay = DateSerial(MyYear, MonthCount + 1, 1) - 1 'put name of month on worksheet tab Set NewSht = Sheets.Add(after:=Sheets(Sheets.Count)) With NewSht .Name = MonthName(MonthCount, abbreviate:=True) .Range("A3") = "Bill Date" .Range("A4") = "Holiday" .Range("A" & FirstShiftRow) = "First Shift Number Needed" .Range("A" & SecondShiftRow) = "Second Shift Number Needed" 'put days of month on column Header For DayCount = 1 To Day(LastDay) MyDate = DateSerial(MyYear, MonthCount, DayCount) .Cells(1, ColCount) = Day(MyDate) .Cells(2, ColCount) = Format(MyDate, "DDD") 'check if Bill Date Select Case Day(MyDate) Case 5, 7, 11, 14, 17, 21, 25, Day(LastDay) BillDate = True Case Else BillDate = False End Select .Cells(3, ColCount) = BillDate 'check if date is a holiday Holiday = False For Each MyHoliday In HolidayRange If MyDate = MyHoliday Then Holiday = True .Cells(4, ColCount) = "Yes" Exit For End If Next MyHoliday If Weekday(MyDate, vbSunday) = vbSaturday Or _ Weekday(MyDate, vbSunday) = vbSunday Or _ Holiday = True Then If BillDate = True Then AM_Needed = 2 PM_Needed = 2 Else AM_Needed = 2 PM_Needed = 1 End If Else If BillDate = True Then AM_Needed = 6 PM_Needed = 3 Else If Weekday(MyDate, vbSunday) = vbFriday Then AM_Needed = 5 PM_Needed = 3 Else AM_Needed = 6 PM_Needed = 2 End If End If End If .Cells(FirstShiftRow, ColCount) = AM_Needed .Cells(SecondShiftRow, ColCount) = PM_Needed ColCount = ColCount + 1 Next DayCount .Columns.AutoFit End With Next MonthCount End Sub -------------------- -- joel ------------------------------------------------------------------------ joel's Profile: 229 View this thread: http://www.thecodecage.com/forumz/showthread.php?t=183222 [url="http://www.thecodecage.com"]Microsoft Office Help[/url]
From: beancurd on 28 Feb 2010 07:33 Hi Joel, sorry for mis-information and very thanks you your big help. On Shift staff (6 staff), total day off is 7 days, it must be include 1 time 2 continuous day off, 1 day off on Saturday, one day off on Sunday, another 3 day off on weekday; Also they cannot continuous more then 5 days work and cannot last day on NIGHT shift, next day on DAY shift 10 employees include the supervisor, 4 staff (include the supervisor) is office hour work 9:00-18:30; another 6 staff is Shift staff, that mean they need to report duty on DAY shift (9:00-18:30) or NIGHT shift (12:00-21:30) How about the job duties schedule, how can I to be fair...... all staff must be on duty job (exclude one of supervisor) A = day N = night N/R = night job duty A/R = day job duty 1 A/E = day job duty 2 A/M = day job duty 3 (NOT include on Sat, Sun and Public Holiday)
From: beancurd on 28 Feb 2010 07:46 Hi Joel, Can you send me your file to me, because I got error message on VBA. Thanks!
From: joel on 28 Feb 2010 08:42
I updated my code. The code below starts by asigning holidays only. See if this looks fair. I setup a queue to select employee for each shift. I assigned a point value depending on the type of day/shift the employee is working. so I start out by going through the entire calendar year and each holiday I choose the employees to work wih the lowest score which I get from the queue. The scores in the queue can be changed if the assinments don't look correct. Job duties may be assigned random based on the people working. I'm also thinking if a person works a holiday on either Saturday or Sunday they should work both weekend dates. Let me know what your holidays are so I'm woking with the same schedule you have. My next task would be to assign weekends. I would check if he person is working a holiday in the middle of the week and not assign the person to work either the weekend before or the weekend after the holiday. Is it better for a person to have both Saturday and Sunday off together or have a person work either Saturday or Sunday. I would then assign the 7 days off for each person. Is the 7 days off for the month? Look at the code and se if there is any problems with my logic for assinments. Based on my scoring system I will assign night before day shift base on the lowest score in the queue. Then fill in the day schedule with the remaining workers. VBA Code: -------------------- Const NumberOfStaff = 10 Const FirstShiftRow = 6 Const SkipRows = 3 Const WorkDayValue = 1 Const PMBonus = 0.2 Const WeekendBonus = 0.5 Const HolidayBonus = 1 Enum WorkType NotScheduled Work Off WorkAM WorkPM End Enum Type CalendarDay AM As Integer PM As Integer Holiday As Boolean BillDate As Boolean Employee(NumberOfStaff) As WorkType End Type Type EmployeeScore Number As Integer Score As Single End Type '366 days to include leap years Dim WorkYear(0 To 365) As CalendarDay Dim Queue(0 To (NumberOfStaff - 1)) As EmployeeScore Sub MakeSchedule() MyYearStr = InputBox("Enter Year : ") MyYear = Val(MyYearStr) 'Delete All sheets except Holiday Application.DisplayAlerts = False For ShtCount = Sheets.Count To 1 Step -1 If Sheets(ShtCount).Name <> "Holidays" Then Sheets(ShtCount).Delete End If Next ShtCount Application.DisplayAlerts = True 'initialize employee queue For EmployeeCount = 0 To (NumberOfStaff - 1) Queue(EmployeeCount).Number = EmployeeCount + 1 Queue(EmployeeCount).Score = 0 Next EmployeeCount Call MakeCalendar(MyYear) Call AssignHolidays(MyYear) Call OutputCalendar(MyYear) End Sub Sub AssignHolidays(MyYear) FirstDay = DateSerial(MyYear, 1, 1) LastDay = DateSerial(MyYear + 1, 1, 1) - 1 DayCount = FirstDay DayOfYear = 0 Do While DayCount <= LastDay If WorkYear(DayOfYear).Holiday = True Then Call SortQueue DayScore = WorkDayValue + HolidayBonus If Weekday(DayCount, vbSunday) = vbSaturday Or _ Weekday(DayCount, vbSunday) = vbSunday Then DayScore = DayScore + WeekendBonus End If QueCount = 0 'assign employee to work based on order in queue 'Assign AM work For EmployeeCount = 1 To WorkYear(DayOfYear).AM EmployeeNumber = Queue(QueCount).Number 'add the day value to employee score Queue(QueCount).Score = Queue(QueCount).Score + _ DayScore WorkYear(DayOfYear).Employee(EmployeeNumber) = WorkAM QueCount = QueCount + 1 Next EmployeeCount 'Assign PM work For EmployeeCount = 1 To WorkYear(DayOfYear).AM EmployeeNumber = Queue(QueCount).Number 'add the day value to employee score Queue(QueCount).Score = Queue(QueCount).Score + _ DayScore + PMBonus WorkYear(DayOfYear).Employee(EmployeeNumber) = WorkPM QueCount = QueCount + 1 Next EmployeeCount End If DayOfYear = DayOfYear + 1 DayCount = DayCount + 1 Loop End Sub Sub SortQueue() For i = 0 To (NumberOfStaff - 2) For j = (i + 1) To (NumberOfStaff - 1) If Queue(i).Score > Queue(j).Score Then 'swap employees temp = Queue(i).Number Queue(i).Number = Queue(j).Number Queue(j).Number = temp temp = Queue(i).Score Queue(i).Score = Queue(j).Score Queue(j).Score = temp End If Next j Next i End Sub Sub MakeCalendar(MyYear) 'Get holiday range With Sheets("Holidays") LastRow = .Range("A" & Rows.Count).End(xlUp).Row Set HolidayRange = .Range("A2:A" & LastRow) End With FirstDay = DateSerial(MyYear, 1, 1) LastDay = DateSerial(MyYear + 1, 1, 1) - 1 DayCount = FirstDay DayOfYear = 0 Do While DayCount <= LastDay 'Get LastDay of the Month as a date 'the last day of the month is the day before 'the 1st day of the next month LastDayofMonth = DateSerial(MyYear, _ Month(DayCount) + 1, 1) - 1 'check if Bill Date Select Case Day(DayCount) Case 5, 7, 11, 14, 17, 21, 25, Day(LastDayofMonth) BillDate = True Case Else BillDate = False End Select WorkYear(DayOfYear).BillDate = BillDate 'check if date is a holiday Holiday = False For Each MyHoliday In HolidayRange If DayCount = MyHoliday Then Holiday = True Exit For End If Next MyHoliday WorkYear(DayOfYear).Holiday = Holiday If Weekday(DayCount, vbSunday) = vbSaturday Or _ Weekday(DayCount, vbSunday) = vbSunday Or _ Holiday = True Then If BillDate = True Then AM_Needed = 2 PM_Needed = 2 Else AM_Needed = 2 PM_Needed = 1 End If Else If BillDate = True Then AM_Needed = 6 PM_Needed = 3 Else If Weekday(DayCount, vbSunday) = vbFriday Then AM_Needed = 5 PM_Needed = 3 Else AM_Needed = 6 PM_Needed = 2 End If End If End If WorkYear(DayOfYear).AM = AM_Needed WorkYear(DayOfYear).PM = PM_Needed For EmployeeCount = 0 To (NumberOfStaff - 1) WorkYear(DayOfYear).Employee(EmployeeCount) = NotScheduled Next EmployeeCount DayOfYear = DayOfYear + 1 DayCount = DayCount + 1 Loop End Sub Sub OutputCalendar(MyYear) FirstDay = DateSerial(MyYear, 1, 1) LastDay = DateSerial(MyYear + 1, 1, 1) - 1 CurrentMonth = 0 DayOfYear = 0 DayCount = FirstDay Do While DayCount <= LastDay If Month(DayCount) <> CurrentMonth Then 'if not first month autformat columns If CurrentMonth <> 0 Then MonthSht.Columns.AutoFit End If 'add newsheet 'put name of month on worksheet tab Set MonthSht = Sheets.Add(after:=Sheets(Sheets.Count)) CurrentMonth = CurrentMonth + 1 With MonthSht .Name = MonthName(CurrentMonth, abbreviate:=True) .Range("A3") = "Bill Date" .Range("A4") = "Holiday" .Range("A" & FirstShiftRow) = "First Shift Number Needed" .Range("A" & FirstShiftRow + 1) = "Second Shift Number Needed" 'Put emplyee number in row header For EmployeeCount = 1 To NumberOfStaff .Range("A" & _ (FirstShiftRow + EmployeeCount + SkipRows)) = _ "Employee " & EmployeeCount Next EmployeeCount End With ColCount = 2 End If With MonthSht 'put days of month on column Header .Cells(1, ColCount) = Day(DayCount) .Cells(2, ColCount) = Format(DayCount, "DDD") .Cells(3, ColCount) = WorkYear(DayOfYear).BillDate .Cells(4, ColCount) = WorkYear(DayOfYear).Holiday .Cells(FirstShiftRow, ColCount) = WorkYear(DayOfYear).AM .Cells(FirstShiftRow + 1, ColCount) = WorkYear(DayOfYear).PM For EmployeeCount = 0 To (NumberOfStaff - 1) Select Case WorkYear(DayOfYear).Employee(EmployeeCount) Case NotScheduled WorkTypeStr = "" Case Work WorkTypeStr = "Work" Case Off WorkTypeStr = "Off" Case WorkAM WorkTypeStr = "Work AM" Case WorkPM WorkTypeStr = "Work PM" Case Else WorkTypeStr = "Error" End Select 'don't output anything if not schedule If Len(WorkTypeStr) > 0 Then .Cells( _ (FirstShiftRow + EmployeeCount + SkipRows), ColCount) = _ WorkTypeStr End If Next EmployeeCount End With ColCount = ColCount + 1 DayOfYear = DayOfYear + 1 DayCount = DayCount + 1 Loop 'format columns in last month MonthSht.Columns.AutoFit End Sub -------------------- -- joel ------------------------------------------------------------------------ joel's Profile: 229 View this thread: http://www.thecodecage.com/forumz/showthread.php?t=183222 [url="http://www.thecodecage.com"]Microsoft Office Help[/url] |