Using VBA in Microsoft Project to Set Up Unusual Calendars
Setting up a pattern of working time in a Project calendar is simple enough when your week runs from Monday to Sunday, but when you have an unusual working pattern setting up the calendar is a pain! This article explains how to use VBA to create a detailed calendar at the click of a button!

Posted by Andrew Gould on 01 July 2011

You need a minimum screen resolution of about 700 pixels width to see our blogs. This is because they contain diagrams and tables which would not be viewable easily on a mobile phone or small laptop. Please use a larger tablet, notebook or desktop computer, or change your screen resolution settings.

Shift Patterns in Microsoft Project Calendars

Creating a pattern of working and non-working time in a Microsoft Project calendar is relatively straightforward, as long as your working times are based on a seven day repeating pattern.  If you want to work with a calendar whose pattern of working time isn't based on a seven day period it can take an awful lot of effort to set up.

Calendar with exceptions

This calendar has had a large number of exceptions added to it in order to create a four day repeating pattern of working time.

The calendar shown above uses a "four day on, four day off" pattern of working time, with the added complication that the working periods alternate between using two different shift patterns.  We originally created this solution to answer a question asked by a delegate on one of our Microsoft Project training courses.  The delegate in question needed four of these unusual calendars setting up.  Doing this manually would have taken hours of work, so we created a small program written in VBA (Visual Basic for Applications) to do the hard work for us!

Using VBA in Microsoft Project

If you own a copy of Microsoft Project then you already have access to VBA and you can follow this series of blog articles to see how we went about writing the program to create the calendars described above.  If you haven't done anything using VBA before, you'll probably want to start by reading this introductory blog series that explains the basics.

Now that you're up to speed with how to get into the VB Editor and working with modules, create a new subroutine called SetupNewCalendar in a new module.

A new subroutine in Project

Depending on the setup of your VB Editor you might need to type in the words Option Explicit yourself.

Creating a Calendar Using VBA

The first job in our program is to create a new calendar that we can manipulate later.  We'll also store a reference to the calendar we create in a variable.  Edit your subroutine so that it looks like this (or just copy and paste the code below into your own module):

Sub SetupNewCalendar()

Dim cal As Calendar

Dim calName As String

'set the new calendar name

calName = "Shift 1a"

'create a new calendar

BaseCalendarCreate calName

'set a reference to the new calendar

Set cal = BaseCalendars(calName)

End Sub

Try running the code to make sure that you don't get any errors, and then go back to Project and check that your new calendar exists.

A new calendar

You should be able to see your new calendar in the Change Working Time dialog box.

 

If you go back to the VB Editor and try to run the subroutine again you'll find that it crashes with a run-time error.

Error message

Clicking debug will show you that it's the line that creates the calendar which is causing the program to crash.

 

The reason the code falls over the second time is that you can't create a new calendar with the same name as an existing one.  To get around this we'll add a little bit of error handling code to our routine.  Add the following code around the offending line:

'create a new calendar

On Error Resume Next

BaseCalendarCreate calName

On Error GoTo 0

The first On Error statement tells the routine that if anything goes wrong after this line, ignore it and carry on with the next line of code.  This means that the calendar will only be created if it doesn't cause an error in doing so.  The second On Error statement is used to reset the error handler, otherwise the subroutine would ignore every error that occurred after the first On Error statement!

If you try running your subroutine now, you should find that it always works.  If the calendar doesn't exist it will be created, and if it does exist the line that tries to create it is ignored.

Setting Up The Shift Pattern

The shift pattern in our example works on a sixteen day repeat, i.e.

  • Four days working on one set of working hours.
  • Four days not working.
  • Four days working on a different set of working hours.
  • Four days not working.

This means we're going to need a variable to keep track of which shift day we're on.

We also need to think about the period of time in the calendar we want to set up the shift pattern for.  In our example the project is going to last for several years so we need several variables to keep track of this too.  Declare and initialise the following new variables.

Sub SetupNewCalendar()

Dim cal As Calendar

Dim calName As String

'a variable to keep track of the shift

Dim shiftDay As Integer

'variables to keep track of years

Dim shiftYear As Integer

Dim shiftYearStart As Integer

Dim shiftYearEnd As Integer

shiftYearStart = Year(Date)

shiftYearEnd = shiftYearStart + 5

shiftDay = 1

The code above sets up our system to change the shift pattern of our calendar starting in whatever year we happen to be in when we run our code and ending five years later.

In Microsoft Project the calendar runs from January 1984 to December 2049.  Be careful about using such a large range of years to loop over - each calendar can only have a maximum of 1400 exceptions and your code will crash if you try to set more than this number.

Looping Over the Days in a Calendar

Probably the easiest way to set up the shift patterns is to loop over the days in the calendar we've just created.  The way a Project calendar is organised in VBA terms is:

  • A calendar contains a collection of years.
  • Each year holds a collection of months.
  • Each month holds a collection of days.
  • Each day has a series of properties relating to the start and end times of the shift.

In order to modify each individual day we need to write a series of nested loops, and in order to do that we need another series of variables.  Add the following variables to your code:

Sub SetupNewCalendar()

Dim cal As Calendar

Dim calName As String

'variables for looping over calendar days

Dim calYr As Year

Dim calMo As Month

Dim calDy As Day

To set up the sequence of nested loops, add the following code to the bottom of your subroutine:

'loop from the first shift year to the end shift year

For shiftYear = shiftYearStart To shiftYearEnd

'set a reference to the current shift year

Set calYr = cal.Years(shiftYear)

'loop over all the months in the current shift year

For Each calMo In calYr.Months

'loop over all the days in the current month

For Each calDy In calMo.Days

'CODE TO SET THE SHIFT PATTERNS GOES HERE

Next calDy

Next calMo

Next shiftYear

This is the code that does most of the hard work in our system.  The final stage is to fill in the details of the shift patterns inside the loop.

Changing the Working Time of Each Day

To set up the working time for each day we need to know which day of the shift pattern we are in and then to change the working time correspondingly.  The easiest way to do this is with an IF statement.  Identify the the comment in the above code that is in all capital letters and replace it with the following code:

'check where we are in the 16 day pattern

'and set the working time appropriately

If shiftDay <= 4="">Then

calDy.Working = True

calDy.Shift1.Start = #7:30:00 AM#

calDy.Shift1.Finish = #1:00:00 PM#

calDy.Shift2.Start = #1:30:00 PM#

calDy.Shift2.Finish = #7:30:00 PM#

ElseIf shiftDay <= 8="">Then

calDy.Working = False

ElseIf shiftDay <= 12="">Then

calDy.Working = True

calDy.Shift1.Start = #12:00:00 PM#

calDy.Shift1.Finish = #5:00:00 PM#

calDy.Shift2.Start = #5:30:00 PM#

calDy.Shift2.Finish = #11:30:00 PM#

Else

calDy.Working = False

End If

'check if we've reached the end of a 16 day pattern

'if so, go back to day 1 of the pattern

If shiftDay = 16 Then

shiftDay = 1

Else

shiftDay = shiftDay + 1

End If

Testing the System

And that should be it!  Save the project you are working on and then try running your code to see if it works.  Don't be alarmed if it seems to take a long time to run - there's a lot going on in this routine.  If it doesn't work, try copying the code from the example shown below.

Sub SetupNewCalendar()

Dim cal As Calendar

Dim calName As String

'variables for looping over calendar days

Dim calYr As Year

Dim calMo As Month

Dim calDy As Day

'a variable to keep track of the shift

Dim shiftDay As Integer

'variables to keep track of years

Dim shiftYear As Integer

Dim shiftYearStart As Integer

Dim shiftYearEnd As Integer

shiftYearStart = Year(Date)

shiftYearEnd = shiftYearStart + 5

shiftDay = 1

'set the new calendar name

calName = "Shift 1a"

'create a new calendar

On Error Resume Next

BaseCalendarCreate calName

On Error GoTo 0

'set a reference to the new calendar

Set cal = ActiveProject.BaseCalendars(calName)

'loop from the first shift year to the end shift year

For shiftYear = shiftYearStart To shiftYearEnd

'set a reference to the current shift year

Set calYr = cal.Years(shiftYear)

'loop over all the months in the current shift year

For Each calMo In calYr.Months

'loop over all the days in the current month

For Each calDy In calMo.Days

'check where we are in the 16 day pattern

'and set the working time appropriately

If shiftDay <= 4="">Then

calDy.Working = True

calDy.Shift1.Start = #7:30:00 AM#

calDy.Shift1.Finish = #1:00:00 PM#

calDy.Shift2.Start = #1:30:00 PM#

calDy.Shift2.Finish = #7:30:00 PM#

ElseIf shiftDay <= 8="">Then

calDy.Working = False

ElseIf shiftDay <= 12="">Then

calDy.Working = True

calDy.Shift1.Start = #12:00:00 PM#

calDy.Shift1.Finish = #5:00:00 PM#

calDy.Shift2.Start = #5:30:00 PM#

calDy.Shift2.Finish = #11:30:00 PM#

Else

calDy.Working = False

End If

'check if we've reached the end of a 16 day pattern

'if so, go back to day 1 of the pattern

If shiftDay = 16 Then

shiftDay = 1

Else

shiftDay = shiftDay + 1

End If

Next calDy

Next calMo

Next shiftYear

End Sub

Conclusion

It takes an awful lot of code to achieve this effect, but it's a lot quicker than doing the same thing by hand!  Hopefully you'll see that it's not too difficult to make changes to the above code to tweak the working times, start and end dates, and the number of days in the shift pattern to make this type of system work for your own calendars.

This blog has 0 threads Add post