none
Customizing recurrent leaves in Project Calendar with VBA RRS feed

  • Question

  • Hi!

    I'm trying to customize a calendar in Project 2013 PRO. My ressources are working on a remote mine site and have a special rythm, working 8 consecutive weeks and being off 2 consecutive weeks.

    I tried to use the exceptions parameter (see discussion "Calendar management : recurrent leave"), but I always end with a conflict when I'm creating the second week off ("The exception conflicts with #1 "First Week Off". They have both the same type of exception, Weekly, and their interval overlaps. Either chang the date range or change the type of exception").

    We ended with no solution, assuming that using VBA would be the best way to customize the calendar. Please let me express my needs :

    We have a cycle of 10 weeks, the 8 first are worked according to the standard calendar and the last 2 are off. Cycle starts when the ressources are entering the project (I assume I'll need 1 calendar per entry in the project). The challenge is also to link the start of the cycle with a task start date.

    I hope my description is complete and clear. If not, feel free to let me know. Would anybody have any suggestion of code I could use?

    Many thanks in advance for your time and assistance !

    Myke.

    Friday, February 15, 2013 8:13 AM

Answers

  • Your code works. I would refine it as:

    Sub CreateProjectCalendar3()
    Dim FirstDayIn, iRotations, NbRot As Integer
    Dim DateIn As Date
    Dim oCal As Calendar
     
    Const BaseCalName = "Standard"
    Const CalName = "Rotations 8/2"
        
        On Error Resume Next
        Set oCal = ActiveProject.BaseCalendars(CalName)
        If Not oCal Is Nothing Then
            oCal.Delete
        End If
        
        Application.BaseCalendarCreate CalName, BaseCalName
        
        'Get information
        FirstDayIn = InputBox("Please input number of days before Resource to be on site and start rotation cycles", "Start date of rotations 8/2")
        NbRot = InputBox("Please input number of rotation cycles", "Number of rotations required")
        
        DateIn = Now + FirstDayIn
        
        For iRotations = 1 To NbRot
         ' Set days 56 to 69 non working, other days based on standard calendar
            ActiveProject.BaseCalendars(CalName).Exceptions.Add Type:=pjDaily, Start:=DateIn + 56, Finish:=DateIn + 69, Name:="2 Weeks off"
        
         'Prepare for next loop
            DateIn = DateIn + 70
        Next
        
        MsgBox "Done", vbOKOnly + vbExclamation
    End Sub
    


    Rod Gill

    The one and only Project VBA Book

    Rod Gill Project Management

    • Marked as answer by Mykegyver Wednesday, February 20, 2013 8:08 AM
    Tuesday, February 19, 2013 9:02 PM
    Moderator
  • Based Trevor Lowing's post (http://officetechsupport.wordpress.com/2010/07/31/rapidly-building-a-custom-ms-project-calendar/), here is my solution :

    Function CreateProjectCalendar2()
     Dim i, FirstDayIn, iRotations, NbRot As Integer
     Dim DateIn, CalName, BaseCalName As String
     BaseCalName = "Standard"
     CalName = "Rotations 8/2"
     
    Dim oCal As Calendar
     
    'Make sure calendar does not already exsits and delete if it does.
     For Each oCal In ActiveProject.BaseCalendars
      If Not oCal Is Nothing Then
       If oCal.Name = CalName Then
       oCal.Delete
       End If
     
      End If
     
     Next
     
    Application.BaseCalendarCreate CalName, BaseCalName
    
    'Get information
    FirstDayIn = InputBox("Please input number of days before Ressource to be on site and start rotation cycles", "Start date of rotations 8/2")
    NbRot = InputBox("Please input number of rotation cycles", "Number of rotations required")
    
    DateIn = Now + FirstDayIn
    
    For iRotations = 1 To NbRot
     ' Set days 56 to 69 non working, other days based on standard calendar
     Application.BaseCalendarEditDays Name:=CalName, StartDate:=DateIn + 56, EndDate:=DateIn + 69, Working:=False, Default:=False
     
     'Prepare for next loop
     DateIn = DateIn + 70
    
    Next
    
    MsgBox "Done"
    
    End Function

    If anybody finds a way to improve this code, feel free to le me know.

    Thanks in advance,

    • Marked as answer by Mykegyver Wednesday, February 20, 2013 8:05 AM
    • Unmarked as answer by Mykegyver Wednesday, February 20, 2013 8:05 AM
    • Marked as answer by Mykegyver Wednesday, February 20, 2013 8:08 AM
    Tuesday, February 19, 2013 4:23 PM

All replies

  • Based Trevor Lowing's post (http://officetechsupport.wordpress.com/2010/07/31/rapidly-building-a-custom-ms-project-calendar/), here is my solution :

    Function CreateProjectCalendar2()
     Dim i, FirstDayIn, iRotations, NbRot As Integer
     Dim DateIn, CalName, BaseCalName As String
     BaseCalName = "Standard"
     CalName = "Rotations 8/2"
     
    Dim oCal As Calendar
     
    'Make sure calendar does not already exsits and delete if it does.
     For Each oCal In ActiveProject.BaseCalendars
      If Not oCal Is Nothing Then
       If oCal.Name = CalName Then
       oCal.Delete
       End If
     
      End If
     
     Next
     
    Application.BaseCalendarCreate CalName, BaseCalName
    
    'Get information
    FirstDayIn = InputBox("Please input number of days before Ressource to be on site and start rotation cycles", "Start date of rotations 8/2")
    NbRot = InputBox("Please input number of rotation cycles", "Number of rotations required")
    
    DateIn = Now + FirstDayIn
    
    For iRotations = 1 To NbRot
     ' Set days 56 to 69 non working, other days based on standard calendar
     Application.BaseCalendarEditDays Name:=CalName, StartDate:=DateIn + 56, EndDate:=DateIn + 69, Working:=False, Default:=False
     
     'Prepare for next loop
     DateIn = DateIn + 70
    
    Next
    
    MsgBox "Done"
    
    End Function

    If anybody finds a way to improve this code, feel free to le me know.

    Thanks in advance,

    • Marked as answer by Mykegyver Wednesday, February 20, 2013 8:05 AM
    • Unmarked as answer by Mykegyver Wednesday, February 20, 2013 8:05 AM
    • Marked as answer by Mykegyver Wednesday, February 20, 2013 8:08 AM
    Tuesday, February 19, 2013 4:23 PM
  • Your code works. I would refine it as:

    Sub CreateProjectCalendar3()
    Dim FirstDayIn, iRotations, NbRot As Integer
    Dim DateIn As Date
    Dim oCal As Calendar
     
    Const BaseCalName = "Standard"
    Const CalName = "Rotations 8/2"
        
        On Error Resume Next
        Set oCal = ActiveProject.BaseCalendars(CalName)
        If Not oCal Is Nothing Then
            oCal.Delete
        End If
        
        Application.BaseCalendarCreate CalName, BaseCalName
        
        'Get information
        FirstDayIn = InputBox("Please input number of days before Resource to be on site and start rotation cycles", "Start date of rotations 8/2")
        NbRot = InputBox("Please input number of rotation cycles", "Number of rotations required")
        
        DateIn = Now + FirstDayIn
        
        For iRotations = 1 To NbRot
         ' Set days 56 to 69 non working, other days based on standard calendar
            ActiveProject.BaseCalendars(CalName).Exceptions.Add Type:=pjDaily, Start:=DateIn + 56, Finish:=DateIn + 69, Name:="2 Weeks off"
        
         'Prepare for next loop
            DateIn = DateIn + 70
        Next
        
        MsgBox "Done", vbOKOnly + vbExclamation
    End Sub
    


    Rod Gill

    The one and only Project VBA Book

    Rod Gill Project Management

    • Marked as answer by Mykegyver Wednesday, February 20, 2013 8:08 AM
    Tuesday, February 19, 2013 9:02 PM
    Moderator
  • Thanks Rod !

    I updated my code.

    Rgds,

    Wednesday, February 20, 2013 8:08 AM
  • Hi!

    I have improved the code by adding automated ability to calculate other rotation rythms.

    Hope this might help other people...

    Sub CreateProjectCalendar3()
    Dim Answer, FirstDayIn, iRotations, NbRot, WeeksOn, WeeksOff As Integer
    Dim DateIn As Date
    Dim oCal As Calendar
     
    Const BaseCalName = "Standard"
        
    Collect:
        WeeksOn = InputBox("Please input number of worked weeks", "Definition of rotations")
        WeeksOff = InputBox("Please input number of weeks off", "Definition of rotations")
        CalName = "Rotations " & WeeksOn & "/" & WeeksOff
        
        Answer = MsgBox("Rotations will be " & WeeksOn & " weeks on / " & WeeksOff & " weeks off." & Chr(10) & "Please confirm.", vbYesNo)
        
        If Answer = 7 Then
         
         GoTo Collect
        
        End If
        
        On Error Resume Next
        Set oCal = ActiveProject.BaseCalendars(CalName)
        If Not oCal Is Nothing Then
            oCal.Delete
        End If
        
        Application.BaseCalendarCreate CalName, BaseCalName
        
        'Get information
        FirstDayIn = InputBox("Please input number of days before Resource to be on site and start rotation cycles", "Start date of rotations 8/2")
        NbRot = InputBox("Please input number of rotation cycles", "Number of rotations required")
        
        DateIn = Now + FirstDayIn
        
        For iRotations = 1 To NbRot
         ' Set days weeks off to non-working, other days based on standard calendar
            ActiveProject.BaseCalendars(CalName).Exceptions.Add Type:=pjDaily, Start:=DateIn + (7 * WeeksOn), Finish:=DateIn + (7 * (WeeksOn + WeeksOff)) - 1, Name:="Left for rotation"
        
         'Prepare for next loop
            DateIn = DateIn + (WeeksOn + WeeksOff) * 7
        Next
        
        MsgBox "Done", vbOKOnly + vbExclamation
    End Sub
    

    Again, any suggestion of improvement is more than welcome !

    Thanks for the support.

    Wednesday, February 20, 2013 11:47 AM