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)

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/sh...d.php?t=183222

Microsoft Office Help

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)

Hi Joel,

Can you send me your file to me, because I got error message on VBA.
Thanks!

And one Big problem, some staff have special request on roster, (e.g.
Staff A want to DAY shift on 13/5/2010, Staff B want to NIGHT shift on
14/05/2010, Staff C want to OFF on 15/5/2010, sometimes have special
request on annual leave too). If Public holiday, will be get
additional one day compensate off , (e.g. on Apr have one day public
holiday, so that the total day off should be 7 days + 1 day compensate
off)….

This is too hard and very complicate roster…I’m very headache to
handle this roster on fair…

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/sh...d.php?t=183222

Microsoft Office Help

Hi Joel,

Shown error message when I run the VBA, "Compile error: Cannot define
a Public user-defined type within an object module"

Pls Help~~

Make sure you copied all the code. Also the code should go into a
Module. Insert a module from the VBa menu Insert then add code to
module.


The fairest approach is to make a schedule for the entire year which is
random like what I've done so far. I could do a monthly schedule which
goes back into the previous days worked a learns which days a person has
already worked. That get more complicated. The schedule requirements
are already complicated.


--
joel
------------------------------------------------------------------------
joel's Profile: 229
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=183222

Microsoft Office Help