Employee Absence Schedule Template
There were some very long lines in the code that wrapped to the next physical
line. I corrected those line wraps and the code worked fine for me:
Option Explicit
Sub create_schedule()
'written by Julie Dall 2006
Dim for_year As Long 'year to create schedule for
Dim num_emp As Long 'number of employees to cater for
Dim i As Long
Dim j As Long
Dim k As Long
Dim m As Long
'populate variables
for_year = InputBox("Enter the year to create the schedule for", _
"Year?", Format(Now, "yyyy"))
num_emp = InputBox("Enter the number of employees to cater for", _
"Number Employees ", 10)
Application.Workbooks.Add 'add a new workbook
'create schedule
ActiveSheet.Range("A1").Select
ActiveCell.Value = "Employee Absence Schedule for " & for_year
ActiveCell.Font.Bold = True
ActiveCell.Font.ColorIndex = 36
ActiveCell.Interior.ColorIndex = 53
For i = 1 To 12
'put months in
ActiveCell.Offset(i + 1 + ((i - 1) * (num_emp + 3)), 0).Value _
= Format(DateSerial(for_year, i, 1), "mmmm yyyy")
ActiveCell.Offset(i + 2 + ((i - 1) * (num_emp + 3)), 0).Value _
= "Employee Name"
'format
ActiveCell.Offset(i + 1 + ((i - 1) * (num_emp + 3)), 0).Font.Bold _
= True
ActiveCell.Offset(i + 1 + ((i - 1) * (num_emp + 3)), 0) _
.Font.ColorIndex = 36
ActiveCell.Offset(i + 1 + ((i - 1) * (num_emp + 3)), 0) _
.Interior.ColorIndex = 53
ActiveCell.Offset(i + 2 + ((i - 1) * (num_emp + 3)), 0) _
.Font.Bold = True
ActiveCell.Offset(i + 2 + ((i - 1) * (num_emp + 3)), 0) _
.Interior.ColorIndex = 19
For k = 1 To num_emp + 1
ActiveCell.Offset(i + 2 + ((i - 1) * (num_emp + 3)) + k, 0) _
.Interior.ColorIndex = 19
Next
'put day header in
For j = 1 To Day(DateSerial(for_year, i + 1, 0))
ActiveCell.Offset(i + 2 + ((i - 1) * (num_emp + 3)), j).Value _
= Left(Format(DateSerial(for_year, i, j), "ddd"), 1)
ActiveCell.Offset(i + 2 + ((i - 1) * (num_emp + 3)), j) _
.Interior.ColorIndex = 19
'format
For k = 0 To num_emp + 1
If ActiveCell.Offset(i + 2 + ((i - 1) * (num_emp + 3)), j) _
.Value = "S" Then
ActiveCell.Offset(i + 2 + ((i - 1) * _
(num_emp + 3)) + k, j).Interior.ColorIndex = 19
End If
Next
'put days in
For m = 1 To num_emp + 1
ActiveCell.Offset(i + 2 + ((i - 1) * (num_emp + 3)) + m, j) _
.Value = Format(DateSerial(for_year, i, j), "d")
Next
Next
Next
'Fit columns
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Columns.AutoFit
Range("A1").Select
Columns(1).HorizontalAlignment = xlJustify
MsgBox "Finished"
End Sub
If it doesn't work, you'll want to be more specific about which lines cause the
errors.
LDP wrote:
I was unable to get the macro to run and received;
Compile error:
Syntax error
when I ran the macro below. I'm using excel 2003, any ideas??
"Jayant" wrote:
Thanks Julie.
I was successful.
Excellent.
"JulieD" wrote:
Hi Jayant
Here's some code that will generate this type of schedule for any year and
any number of employees.
'start code
Sub create_schedule()
'written by Julie Dall 2006
Dim for_year As Long 'year to create schedule for
Dim num_emp As Long 'number of employees to cater for
Dim i, j, k, m As Long
'populate variables
for_year = InputBox("Enter the year to create the schedule for",
"Year?", Format(Now, "yyyy"))
num_emp = InputBox("Enter the number of employees to cater for", "Number
Employees", 10)
Application.Workbooks.Add 'add a new workbook
'create schedule
ActiveSheet.Range("A1").Select
ActiveCell.Value = "Employee Absence Schedule for " & for_year
ActiveCell.Font.Bold = True
ActiveCell.Font.ColorIndex = 36
ActiveCell.Interior.ColorIndex = 53
For i = 1 To 12
'put months in
ActiveCell.Offset(i + 1 + ((i - 1) * (num_emp + 3)), 0).Value =
Format(DateSerial(for_year, i, 1), "mmmm yyyy")
ActiveCell.Offset(i + 2 + ((i - 1) * (num_emp + 3)), 0).Value =
"Employee Name"
'format
ActiveCell.Offset(i + 1 + ((i - 1) * (num_emp + 3)), 0).Font.Bold =
True
ActiveCell.Offset(i + 1 + ((i - 1) * (num_emp + 3)),
0).Font.ColorIndex = 36
ActiveCell.Offset(i + 1 + ((i - 1) * (num_emp + 3)),
0).Interior.ColorIndex = 53
ActiveCell.Offset(i + 2 + ((i - 1) * (num_emp + 3)), 0).Font.Bold =
True
ActiveCell.Offset(i + 2 + ((i - 1) * (num_emp + 3)),
0).Interior.ColorIndex = 19
For k = 1 To num_emp + 1
ActiveCell.Offset(i + 2 + ((i - 1) * (num_emp + 3)) + k,
0).Interior.ColorIndex = 19
Next
'put day header in
For j = 1 To Day(DateSerial(for_year, i + 1, 0))
ActiveCell.Offset(i + 2 + ((i - 1) * (num_emp + 3)), j).Value =
Left(Format(DateSerial(for_year, i, j), "ddd"), 1)
ActiveCell.Offset(i + 2 + ((i - 1) * (num_emp + 3)),
j).Interior.ColorIndex = 19
'format
For k = 0 To num_emp + 1
If ActiveCell.Offset(i + 2 + ((i - 1) * (num_emp + 3)),
j).Value = "S" Then
ActiveCell.Offset(i + 2 + ((i - 1) * (num_emp + 3)) + k,
j).Interior.ColorIndex = 19
End If
Next
'put days in
For m = 1 To num_emp + 1
ActiveCell.Offset(i + 2 + ((i - 1) * (num_emp + 3)) + m,
j).Value = Format(DateSerial(for_year, i, j), "d")
Next
Next
Next
'Fit columns
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Columns.AutoFit
Range("A1").Select
Columns(1).HorizontalAlignment = xlJustify
MsgBox "Finished"
End Sub
'end code
this code can be copied & pasted into the code module of a workbook (line
breaks removed) and when run, it will create a new workbook for you with the
schedule information.
If you would prefer, email me at the address below and i will send you a
workbook containing the code.
--
Cheers
JulieD
Excel MVP
julied_ng at hctsReMoVeThIs dot net dot au
"Jayant" wrote:
Hi,
By default this template is for year 2005. I need it for year 2006. Any idea
how to get, how to chage?
Thanks
--
Dave Peterson
|