none
Project 2013 - How to create a resource working time 'exception' report

    Question

  • Hi all, I'm hoping someone can assist me (I'm a beginner with project).  

    Within Project Pro 2013 I've created an 8 month project plan and assigned my resources.  I've then used the 'resource sheet' and double clicked on each of the resources to set their working time unavailability (due to leave, training etc.) by clicking on the 'Change Working Time' button under the 'Resource Information' dialogue box (which appears when you double click the resource under the resource sheet).

    What I'd like to do now is create a report which lists all of my resources and shows their 'unavailability' (i.e. working time exceptions) in a table (or calendar) so I can assess which of my resources have overlapping/conflicting unavailable times (i.e. leave etc.).

    All assistance appreciated.

    cheers Tony

    Wednesday, February 13, 2013 7:55 AM

Answers

  • Hi Tony,

    Macro needed some tweaking. I have have modified it to include Finish Time and also to execute it only for "Work Resources" and not for material or cost resources. 

    Sub ResourceExceptions()

    Dim MyXL As Object
    Set MyXL = CreateObject("Excel.Application")
    MyXL.Workbooks.Add
    MyXL.Visible = True

    MyXL.ActiveWorkbook.worksheets.Add.Name = "Exception Report"
    MyXL.ActiveWorkbook.worksheets("Exception Report").Activate

    Set xlRange = MyXL.activesheet.Range("A1")

    xlRange.Range("A1") = "Resource Name"
    xlRange.Range("B1") = "Start Time"
    xlRange.Range("C1") = "Finish Time"
    i = 2
        For Each R In ActiveProject.Resources
            If Not (R Is Nothing) Then
            ctr = 1
            If R.Type = pjResourceTypeWork Then
            If R.Calendar.Exceptions.Count > 0 Then
            For Each E In R.Calendar.Exceptions
            xlRange.Range("A" & i) = R.Name
            xlRange.Range("b" & i) = R.Calendar.Exceptions.Item(ctr).Start
            xlRange.Range("c" & i) = R.Calendar.Exceptions.Item(ctr).Finish
            ctr = ctr + 1
            i = i + 1
            Next
            End If
            End If
            End If
        Next R
    End Sub

    • Marked as answer by Budgie6059 Sunday, February 17, 2013 8:01 AM
    Sunday, February 17, 2013 7:59 AM
  • Patrick,

    Okay, try this. The format may not be quite what you had in mind, but the basic info is there. Question answered?

    Option Explicit
    Sub CalendarExceptions()

    Dim MyXL As Object
    Set MyXL = CreateObject("Excel.Application")
    Dim i As Integer, j As Integer
    Dim E As Exception
    Dim R As Resource
    Dim xlRng As Range

    'open Excel, define workbook, and set column headers
    MyXL.Workbooks.Add
    MyXL.Visible = True
    MyXL.ActiveWorkbook.Worksheets.Add.Name = "Exception Report"
    MyXL.ActiveWorkbook.Worksheets("Exception Report").Activate
    Set xlRng = MyXL.ActiveSheet.Range("A1")
    xlRng.Range("A1") = "Proj Cal Holidays"
    xlRng.Range("B1") = "Start Date"
    xlRng.Range("C1") = "Finish Date"
    xlRng.Range("E1") = "Res Name"
    xlRng.Range("F1") = "Res Base Cal"
    xlRng.Range("G1") = "Base Cal Excep"
    xlRng.Range("H1") = "Start Date"
    xlRng.Range("I1") = "Finish Date"
    xlRng.Range("K1") = "Resource Name"
    xlRng.Range("L1") = "Res Excep"
    xlRng.Range("M1") = "Start Date"
    xlRng.Range("N1") = "Finish Date"

    'First gather and export Project calendar exceptions
    i = 2
    If ActiveProject.Calendar.Exceptions.Count > 0 Then
        For Each E In ActiveProject.Calendar.Exceptions
            xlRng.Range("A" & i) = E.Name
            xlRng.Range("B" & i) = E.Start
            xlRng.Range("C" & i) = E.Finish
            i = i + 1
        Next
    End If

    'Next, gather and export resource base calendar exceptions along with
    '   resource calendar exceptions
    i = 2
    For Each R In ActiveProject.Resources
        If Not R Is Nothing Then
            j = i
            If R.Type = pjResourceTypeWork Then
                    For Each E In R.Calendar.BaseCalendar.Exceptions
                        xlRng.Range("E" & i) = R.Name
                        xlRng.Range("F" & i) = R.Calendar.BaseCalendar.Name
                        xlRng.Range("G" & i) = E.Name
                        xlRng.Range("H" & i) = E.Start
                        xlRng.Range("I" & i) = E.Finish
                        i = i + 1
                    Next E
                    For Each E In R.Calendar.Exceptions
                        xlRng.Range("K" & j) = R.Name
                        xlRng.Range("L" & j) = E.Name
                        xlRng.Range("M" & j) = E.Start
                        xlRng.Range("N" & j) = E.Finish
                        j = j + 1
                    Next E
            End If
        End If
    Next R
    MyXL.ActiveWorkbook.Worksheets("Exception Report").Columns("A:N").AutoFit
    End Sub

    John

    Monday, June 02, 2014 9:23 PM
  • Hi Tony,

    Team planner view shows the "Non Working time" for resources. Select View >> Team Planner

    Normally it shows non working time in "red". You can customize it by right clicking in Time scale >> Non Working time.

    Thanks,

    Kiran K.

    • Marked as answer by Budgie6059 Thursday, February 14, 2013 1:20 AM
    Wednesday, February 13, 2013 9:26 AM
  • Francois,

    Since you seem more interested in just the base calendar exceptions and not resource calendar exceptions, I streamlined the macro to only provide an exception report for all base calendars in a given (i.e. random) Project file.

    Hope this helps.

    John

    Sub BaseCalendarExceptions()
    'This macro exports the exceptions for all base calendars in a given Project file
    '(modified version of the CalendarExceptions macro published previously in this forum)
    ' Written by John - Project 2/8/16
    Dim MyXL As Object
    Set MyXL = CreateObject("Excel.Application")
    Dim i As Integer, j As Integer
    Dim BC As Calendar
    Dim E As Exception
    Dim xlRng As Range

    'open Excel, define workbook, and set column headers
    MyXL.Workbooks.Add
    MyXL.Visible = True
    MyXL.ActiveWorkbook.Worksheets.Add.Name = "BaseCal Exc Report"
    MyXL.ActiveWorkbook.Worksheets("BaseCal Exc Report").Activate
    Set xlRng = MyXL.ActiveSheet.Range("A1")
    xlRng.Range("A1") = "Proj Cal Holidays"
    xlRng.Range("B1") = "Base Calendar"
    xlRng.Range("C1") = "Start Date"
    xlRng.Range("D1") = "Finish Date"

    'Gather and export Project calendar exceptions
    j = 0
    For Each BC In ActiveProject.BaseCalendars
        i = 2 + j
        If BC.Exceptions.count > 0 Then
            For Each E In BC.Exceptions
                xlRng.Range("A" & i) = E.Name
                xlRng.Range("B" & i) = BC.Name
                xlRng.Range("C" & i) = E.Start
                xlRng.Range("D" & i) = E.Finish
                i = i + 1
            Next E
        End If
        j = i
    Next BC
    MyXL.ActiveWorkbook.Worksheets("BaseCal Exc Report").Columns("A:D").AutoFit

    End Sub

    Tuesday, February 09, 2016 2:44 AM

All replies

  • Hi Tony,

    Team planner view shows the "Non Working time" for resources. Select View >> Team Planner

    Normally it shows non working time in "red". You can customize it by right clicking in Time scale >> Non Working time.

    Thanks,

    Kiran K.

    • Marked as answer by Budgie6059 Thursday, February 14, 2013 1:20 AM
    Wednesday, February 13, 2013 9:26 AM
  • Tony --
     
    Unfortunately, the new Reports feature in Project 2013 does not allow you to create a resource calendar report to show nonworking time the way we could do that using the old Reports feature in Project 2010 and earlier.  Lacking that functionality, I like the suggestion from Kiran to see the periods of nonworking time using the Team Planner view.  This assumes, of course, that you are using the Professional version of Project 2013, since the Team Planner view is not available in the Standard version.  Hope this helps.
     

    Dale A. Howard [MVP]
    VP of Educational Services
    msProjectExperts
    http://www.msprojectexperts.com
    http://www.projectserverexperts.com
    "We write the books on Project Server"

    Wednesday, February 13, 2013 1:38 PM
    Moderator
  • Hi guys, thanks for your assistance.

    Kiran, I tried the method you suggested and can see the info I need (thanks :-).  If I may ask a quick follow up on this method though. Is there anyway within the Team Planner view to:

    1. remove the 'task/activities' from being visible?  i.e. at present in the calendar window (right pane) the resource lines include activities
    2. hide the 'standard calendars' non-working times, i.e. Weekends, public holidays etc that apply to all resources etc?

    cheers Tony

    Wednesday, February 13, 2013 11:47 PM
  • Tony --
     
    The answer to both questions is no.  Sorry.  Hope this helps.

    Dale A. Howard [MVP]
    VP of Educational Services
    msProjectExperts
    http://www.msprojectexperts.com
    http://www.projectserverexperts.com
    "We write the books on Project Server"

    Thursday, February 14, 2013 12:21 AM
    Moderator
  • Thanks Dale.  I'll live with what I can do then.

    cheers Tony

    Thursday, February 14, 2013 1:20 AM
  • Hi Tony,

    I have created a quick macro to export non working time from MS Project to excel. Use below steps

    Open the Project File

    Press Alt + F 11

    Right click on VBAProject(ProjectName) and select add Module

    Copy the below code in the module

    ==============

    Sub ResourceExceptions()

    Dim MyXL As Object
    Set MyXL = CreateObject("Excel.Application")
    MyXL.Workbooks.Add
    MyXL.Visible = True

    MyXL.ActiveWorkbook.worksheets.Add.Name = "Exception Report"
    MyXL.ActiveWorkbook.worksheets("Exception Report").Activate

    Set xlRange = MyXL.activesheet.Range("A1")

    xlRange.Range("A1") = "Resource Name"
    xlRange.Range("B1") = "Non Working Time"
    i = 2
        For Each R In ActiveProject.Resources
            If Not (R Is Nothing) Then
            ctr = 1
            If R.Calendar.Exceptions.Count > 0 Then
            For Each E In R.Calendar.Exceptions
            xlRange.Range("A" & i) = R.Name
            xlRange.Range("b" & i) = R.Calendar.Exceptions.Item(ctr).Start
            ctr = ctr + 1
            i = i + 1
            Next
            End If
            End If
        Next R
    End Sub

    ================== 

    You can run this macro using view >> Macro >> view macro >> select ResourceExceptions and click run

    To make this macro available for all project copy this macro in global.mpt. File >> Info >> Organizer >> Module >> Select "ResourceExceptions" from Project to global.mpt


    Thanks,

    Kiran K.

    Friday, February 15, 2013 2:59 PM
  • Hi Kiran,

    this kind of report is exactly what I was after, thanks for assisting however when I run the report I only seem to get the 'start date' of the unavailable time.  i.e. the report doesn't show the 'start' and 'finish' dates of the unavailable time.  Hopefully I've implemented your macro right (everything seemed to go in ok).. 

    As an example, in my project I've set my own (for me as the 'resource') unavailable time as follows:

    You can see I'm away from 22/4 through to 3/5 however when I run the report I see that I'm listed in it but only with the 'start' date, snippet of report output follows:

    Is this due to something I've done in adding the macro (i.e. does the macro work like this for you also) OR does the macro need tweaking to show the 'finish' date (and if so, would you mind tweaking it :-)...

    Cheers Tony

    Sunday, February 17, 2013 7:27 AM
  • Hi Tony,

    Macro needed some tweaking. I have have modified it to include Finish Time and also to execute it only for "Work Resources" and not for material or cost resources. 

    Sub ResourceExceptions()

    Dim MyXL As Object
    Set MyXL = CreateObject("Excel.Application")
    MyXL.Workbooks.Add
    MyXL.Visible = True

    MyXL.ActiveWorkbook.worksheets.Add.Name = "Exception Report"
    MyXL.ActiveWorkbook.worksheets("Exception Report").Activate

    Set xlRange = MyXL.activesheet.Range("A1")

    xlRange.Range("A1") = "Resource Name"
    xlRange.Range("B1") = "Start Time"
    xlRange.Range("C1") = "Finish Time"
    i = 2
        For Each R In ActiveProject.Resources
            If Not (R Is Nothing) Then
            ctr = 1
            If R.Type = pjResourceTypeWork Then
            If R.Calendar.Exceptions.Count > 0 Then
            For Each E In R.Calendar.Exceptions
            xlRange.Range("A" & i) = R.Name
            xlRange.Range("b" & i) = R.Calendar.Exceptions.Item(ctr).Start
            xlRange.Range("c" & i) = R.Calendar.Exceptions.Item(ctr).Finish
            ctr = ctr + 1
            i = i + 1
            Next
            End If
            End If
            End If
        Next R
    End Sub

    • Marked as answer by Budgie6059 Sunday, February 17, 2013 8:01 AM
    Sunday, February 17, 2013 7:59 AM
  • You're a legend, that's perfect!

    Thanks heaps for your help.

    cheers Tony

    Sunday, February 17, 2013 8:01 AM
  • Thanks,

    How to add the exceptions coming from the Base calendar?

    Patrick

    Friday, May 30, 2014 7:47 PM
  • Patrick,

    Not sure exactly what you mean by "add the exceptions". Are you trying to add exceptions to the project calendar or are you trying to add the project calendar exceptions to the export? If the latter, the following tweaked version of Kiran's macro will give you that.

    Sub ProjCalExceptionReport()

    Dim MyXL As Object
    Dim i As Integer
    Dim xlRng As Range

    Set MyXL = CreateObject("Excel.Application")
    MyXL.Workbooks.Add
    MyXL.Visible = True
    MyXL.ActiveWorkbook.Worksheets.Add.Name = "Exception Report"
    MyXL.ActiveWorkbook.Worksheets("Exception Report").Activate
    Set xlRng = MyXL.ActiveSheet.Range("A1")
    xlRng.Range("B1") = "Start Time"
    xlRng.Range("C1") = "Finish Time"
    i = 2
    If ActiveProject.Calendar.Exceptions.Count > 0 Then
        For Each e In ActiveProject.Calendar.Exceptions
            xlRng.Range("b" & i) = e.Start
            xlRng.Range("c" & i) = e.Finish
            i = i + 1
        Next
    End If

    End Sub

    John

    If this response gives you what you need, please mark it as an answer.

    Saturday, May 31, 2014 1:54 AM
  • Hi John

    Yes, option 2. I want to display both the Holidays coming from ActiveProject.Resources.BaseCalendar  and the days off coming from ActiveProject.Resources.Calendar.Exceptions

    Since I don't know how to write this would you build the query(macro) that would put those 2 calendars combine for me please :-) ?

    Also, the macro you provided gives this : Compile Error: User-Defined type not define.

    Thanks for your help

    Patrick


    Monday, June 02, 2014 12:41 PM
  • Patrick,

    Okay, try this one:

    Option Explicit
    Sub CalendarExceptionsReport()

    Dim MyXL As Object
    Set MyXL = CreateObject("Excel.Application")
    Dim i As Integer, ctr As Integer
    Dim E As Exception
    Dim R As Resource
    Dim xlRng As Range

    'open Excel, define workbook, and set column headers
    MyXL.Workbooks.Add
    MyXL.Visible = True
    MyXL.ActiveWorkbook.Worksheets.Add.Name = "Exception Report"
    MyXL.ActiveWorkbook.Worksheets("Exception Report").Activate
    Set xlRng = MyXL.ActiveSheet.Range("A1")
    xlRng.Range("A1") = "Holiday"
    xlRng.Range("B1") = "Start Date"
    xlRng.Range("C1") = "Finish Date"
    xlRng.Range("E1") = "Resource Name"
    xlRng.Range("F1") = "Start Date"
    xlRng.Range("G1") = "Finish Date"

    'First gather and export Project calendar exceptions
    i = 2
    If ActiveProject.Calendar.Exceptions.Count > 0 Then
        For Each E In ActiveProject.Calendar.Exceptions
            xlRng.Range("A" & i) = E.Name
            xlRng.Range("B" & i) = E.Start
            xlRng.Range("C" & i) = E.Finish
            i = i + 1
        Next
    End If

    'Next, gather and export resource calendar exceptions
    i = 2
    For Each R In ActiveProject.Resources
        If Not R Is Nothing Then
            ctr = 1
            If R.Type = pjResourceTypeWork Then
                If R.Calendar.Exceptions.Count > 0 Then
                    For Each E In R.Calendar.Exceptions
                        xlRng.Range("E" & i) = R.Name
                        xlRng.Range("F" & i) = R.Calendar.Exceptions.Item(ctr).Start
                        xlRng.Range("G" & i) = R.Calendar.Exceptions.Item(ctr).Finish
                        ctr = ctr + 1
                        i = i + 1
                    Next
                End If
            End If
        End If
    Next R
    MyXL.ActiveWorkbook.Worksheets("Exception Report").Columns("A:G").AutoFit
    End Sub

    Again, if this answers your question, please mark it as the answer.

    John

    Monday, June 02, 2014 3:12 PM
  • Hi John,

    Almost.  Can we read the exceptions from ActiveProject.Resources.BaseCalendar (each resource could have a different base calendar) instead on the project calendar ActiveProject.Calendar?

    Thanks

    Patrick

    Monday, June 02, 2014 7:55 PM
  • Patrick,

    Okay, try this. The format may not be quite what you had in mind, but the basic info is there. Question answered?

    Option Explicit
    Sub CalendarExceptions()

    Dim MyXL As Object
    Set MyXL = CreateObject("Excel.Application")
    Dim i As Integer, j As Integer
    Dim E As Exception
    Dim R As Resource
    Dim xlRng As Range

    'open Excel, define workbook, and set column headers
    MyXL.Workbooks.Add
    MyXL.Visible = True
    MyXL.ActiveWorkbook.Worksheets.Add.Name = "Exception Report"
    MyXL.ActiveWorkbook.Worksheets("Exception Report").Activate
    Set xlRng = MyXL.ActiveSheet.Range("A1")
    xlRng.Range("A1") = "Proj Cal Holidays"
    xlRng.Range("B1") = "Start Date"
    xlRng.Range("C1") = "Finish Date"
    xlRng.Range("E1") = "Res Name"
    xlRng.Range("F1") = "Res Base Cal"
    xlRng.Range("G1") = "Base Cal Excep"
    xlRng.Range("H1") = "Start Date"
    xlRng.Range("I1") = "Finish Date"
    xlRng.Range("K1") = "Resource Name"
    xlRng.Range("L1") = "Res Excep"
    xlRng.Range("M1") = "Start Date"
    xlRng.Range("N1") = "Finish Date"

    'First gather and export Project calendar exceptions
    i = 2
    If ActiveProject.Calendar.Exceptions.Count > 0 Then
        For Each E In ActiveProject.Calendar.Exceptions
            xlRng.Range("A" & i) = E.Name
            xlRng.Range("B" & i) = E.Start
            xlRng.Range("C" & i) = E.Finish
            i = i + 1
        Next
    End If

    'Next, gather and export resource base calendar exceptions along with
    '   resource calendar exceptions
    i = 2
    For Each R In ActiveProject.Resources
        If Not R Is Nothing Then
            j = i
            If R.Type = pjResourceTypeWork Then
                    For Each E In R.Calendar.BaseCalendar.Exceptions
                        xlRng.Range("E" & i) = R.Name
                        xlRng.Range("F" & i) = R.Calendar.BaseCalendar.Name
                        xlRng.Range("G" & i) = E.Name
                        xlRng.Range("H" & i) = E.Start
                        xlRng.Range("I" & i) = E.Finish
                        i = i + 1
                    Next E
                    For Each E In R.Calendar.Exceptions
                        xlRng.Range("K" & j) = R.Name
                        xlRng.Range("L" & j) = E.Name
                        xlRng.Range("M" & j) = E.Start
                        xlRng.Range("N" & j) = E.Finish
                        j = j + 1
                    Next E
            End If
        End If
    Next R
    MyXL.ActiveWorkbook.Worksheets("Exception Report").Columns("A:N").AutoFit
    End Sub

    John

    Monday, June 02, 2014 9:23 PM
  • Working, thanks alot.

    Patrick

    Tuesday, June 03, 2014 5:12 PM
  • Patrick,

    You're welcome. I hope you meant to mark my response as the answer instead of your response as a proposed answer.

    John

    Tuesday, June 03, 2014 5:19 PM
  • Patrick,

    John has already provided an excellent solution to your problem.

    I thought you may also like to see the subroutine here at http://www.msptips.com/ListCalendars.html for details of the resource calendar exceptions. Any feedback is welcome at ikocaman.pm[at]gmail.com.

    Regards -- Ismet


    Thursday, June 12, 2014 10:40 AM
  • Is there also a way to do the same to a project calendar?

    to show to project calendar exeptions and/or nonworking days in excel?

    (or the opposite - only the available working days)


    Ofir Marco , MCTS P.Z. Projects

    Thursday, July 31, 2014 8:24 AM
  • Is there also a way to do the same to a project calendar?

    to show to project calendar exeptions and/or nonworking days in excel?

    (or the opposite - only the available working days)


    Ofir Marco , MCTS P.Z. Projects

    Thursday, July 31, 2014 8:25 AM
  • Hi Ofir,

    A workaround that could be used is to create a generic resource for each calendar and associate them. For example the Ontario calendar might be associated with a generic "ontario" resource. Then just retrieve the capacity of the resource using a simple Excel or SSRS report.


    Hope this helps,


    Guillaume Rouyre, MBA, MCP, MCTS |

    Thursday, July 31, 2014 12:14 PM
    Moderator
  • Ofir,

    The first version of the macro I posted on May 31, 2014, (see thread above), creates a report in Excel of the Project calendar exceptions. Does that not do what you want? If not, what is missing?

    John

    Thursday, July 31, 2014 2:28 PM
  • yes John, i saw it later.

    It's what i needed.

    I made some adjustements on the code to fit the output i need. But it helped a lot.


    Ofir Marco , MCTS P.Z. Projects

    Sunday, August 03, 2014 5:51 AM
  • Ofir,

    I'm glad your were able to use it.

    John

    Sunday, August 03, 2014 2:36 PM
  • Hi everyone,

     

    I've been trying to extract the exceptions of all the calendars defined in a random project, but using the solution offered by John - Project, I only get the base calendar.

     

    Is it possible to extract the others calendars exceptions as well?

     

    Thanks a lot

    PS: I'm working on Projet 2007 (company restrictions...)


    Friday, February 05, 2016 10:54 AM
  • Francois,

    Yes, it will require the addition of another loop to cycle through all of the BaseCalendars for the ActiveProject. Or, if you are looking for the exceptions of all calendars available in the Project Global, the OrganizerMoveItem Method could be used to transfer all Global calendars to the active project and then cycle through all the base calendars of the active project.

    John

    Friday, February 05, 2016 3:41 PM
  • Hi John,

    Thanks for your answer.

    So it's possible, that's a great news. I've started searching in the msp help, but haven't got a clue how to cycle through the base calendars in the Activeproject. I'm used to VBA with Excel, but still learning to use it with MSP.

    Monday, February 08, 2016 9:09 AM
  • Francois,

    If I have some time later today, I'll modify the macro to include the necessary loop.

    John

    Monday, February 08, 2016 4:38 PM
  • Francois,

    Since you seem more interested in just the base calendar exceptions and not resource calendar exceptions, I streamlined the macro to only provide an exception report for all base calendars in a given (i.e. random) Project file.

    Hope this helps.

    John

    Sub BaseCalendarExceptions()
    'This macro exports the exceptions for all base calendars in a given Project file
    '(modified version of the CalendarExceptions macro published previously in this forum)
    ' Written by John - Project 2/8/16
    Dim MyXL As Object
    Set MyXL = CreateObject("Excel.Application")
    Dim i As Integer, j As Integer
    Dim BC As Calendar
    Dim E As Exception
    Dim xlRng As Range

    'open Excel, define workbook, and set column headers
    MyXL.Workbooks.Add
    MyXL.Visible = True
    MyXL.ActiveWorkbook.Worksheets.Add.Name = "BaseCal Exc Report"
    MyXL.ActiveWorkbook.Worksheets("BaseCal Exc Report").Activate
    Set xlRng = MyXL.ActiveSheet.Range("A1")
    xlRng.Range("A1") = "Proj Cal Holidays"
    xlRng.Range("B1") = "Base Calendar"
    xlRng.Range("C1") = "Start Date"
    xlRng.Range("D1") = "Finish Date"

    'Gather and export Project calendar exceptions
    j = 0
    For Each BC In ActiveProject.BaseCalendars
        i = 2 + j
        If BC.Exceptions.count > 0 Then
            For Each E In BC.Exceptions
                xlRng.Range("A" & i) = E.Name
                xlRng.Range("B" & i) = BC.Name
                xlRng.Range("C" & i) = E.Start
                xlRng.Range("D" & i) = E.Finish
                i = i + 1
            Next E
        End If
        j = i
    Next BC
    MyXL.ActiveWorkbook.Worksheets("BaseCal Exc Report").Columns("A:D").AutoFit

    End Sub

    Tuesday, February 09, 2016 2:44 AM
  • John,

    It looks awesome and seems to do exatly what I've been looking for.

    I'm testing it right nom with little tweaks (a group of three columns for each calendars).

    Thanks a lot !

    I'll mark your post as answer right after my tests.

    Tuesday, February 09, 2016 8:15 AM
  • Well, the first test with your base macro is perfect.

    It works and extract everything I need.

    Huge thanks !

    Marked your post as an answer  ;)

    Tuesday, February 09, 2016 8:18 AM
  • And here is the tweaked version:

    Sub BaseCalendarExceptions()
    'This macro exports the exceptions for all base calendars in a given Project file
    '(modified version of the CalendarExceptions macro published previously in this forum)
    ' Written by John - Project 2/8/16
    ' Little tweaks by Francois 2/8/16

    Dim MyXL As Object
    Set MyXL = CreateObject("Excel.Application")
    Dim i As Integer, j As Integer
    Dim BC As Calendar
    Dim E As Exception
    Dim xlRng As Range

    'open Excel, define workbook, and set column headers
    MyXL.Workbooks.Add
    MyXL.Visible = True
    MyXL.ActiveWorkbook.Worksheets.Add.Name = "BaseCal Exc Report"
    MyXL.ActiveWorkbook.Worksheets("BaseCal Exc Report").Activate
    Set xlRng = MyXL.ActiveSheet.Range("A1")



    'Gather and export Project calendar exceptions
    j = 1
    For Each BC In ActiveProject.BaseCalendars
        i = 3
        xlRng.Cells(i - 2, j) = BC.Name
        xlRng.Cells(i - 1, j) = "Proj Cal Holidays"
        xlRng.Cells(i - 1, j + 1) = "Start Date"
        xlRng.Cells(i - 1, j + 2) = "Finish Date"
        
        If BC.Exceptions.Count > 0 Then
            For Each E In BC.Exceptions
                If E.Name = "" Then
                    xlRng.Cells(i, j) = "[UnNamed]"
                    Else
                    xlRng.Cells(i, j) = E.Name
                End If
                xlRng.Cells(i, j + 1) = E.Start
                xlRng.Cells(i, j + 2) = E.Finish
                i = i + 1
            Next E
        End If
        j = j + 3
    Next BC
    MyXL.ActiveWorkbook.Worksheets("BaseCal Exc Report").Columns("A:Z").AutoFit

    End Sub

    Still needs to work on the autofit part, but your code was perfect  ;)

    Tuesday, February 09, 2016 8:37 AM
  • Francois,

    You're welcome and thanks for the feedback.

    John

    Tuesday, February 09, 2016 3:37 PM
  • Hey John,

    I'd like to ask you one last question.

    I tried to extract the shifts start and end time using vba like this:

    Dim MyXL As Object
    Set MyXL = CreateObject("Excel.Application")
    Dim i As Integer, j As Integer
    Dim BC As Calendar
    Dim eWeekDay As WorkWeekDay
    Dim xlRng As Range

    'open Excel, define workbook, and set column headers
    MyXL.Workbooks.Add
    MyXL.Visible = True
    MyXL.ActiveWorkbook.Worksheets.Add.Name = "Temps de travail"
    MyXL.ActiveWorkbook.Worksheets("Temps de travail").Activate
    Set xlRng = MyXL.ActiveSheet.Range("A1")
    j = 1
    For Each BC In ActiveProject.BaseCalendars
        i = 1
        Set xlRng = MyXL.ActiveSheet.Range("A1")
        xlRng.Cells(i, j) = BC.Name
        xlRng.Cells(i + 1, j) = "Début shift 1"
        xlRng.Cells(i + 1, j + 1) = eWeekDay.Shift1.Start
        xlRng.Cells(i + 2, j) = "Fin shift 1"
        xlRng.Cells(i + 2, j + 1) = eWeekDay.Shift1.Finish
        xlRng.Cells(i + 3, j) = "Début shift 2"
        xlRng.Cells(i + 3, j + 1) = eWeekDay.Shift2.Start
        xlRng.Cells(i + 4, j) = "Fin shift 2"
        xlRng.Cells(i + 4, j + 1) = eWeekDay.Shift2.Finish
        j = j + 1
    Next BC

    I get the error 424, undefiened object when the code tries to execute eWeekDay.Shift1.Start.

    Any idea on how to fix that?

    Thanks in advance !

    5 hours 30 minutes ago
  • Well I made it work after lots of unsuccesfull results.

    Here is what I ended up with:

    'open Excel, define workbook, and set column headers
    MyXL.Workbooks.Add
    MyXL.Visible = True
    MyXL.ActiveWorkbook.Worksheets.Add.Name = "Temps de travail"
    MyXL.ActiveWorkbook.Worksheets("Temps de travail").Activate
    Set xlRng = MyXL.ActiveSheet.Range("A1")
    i = 1
    For Each BC In ActiveProject.BaseCalendars
        k = 1
        j = 1
        Set xlRng = MyXL.ActiveSheet.Range("A1")
        xlRng.cells(i, j) = BC.Name
        Do
        
        If j = 1 Then
        xlRng.cells(i + 1, j) = "Dimanche"
        ElseIf j = 3 Then
        xlRng.cells(i + 1, j) = "Lundi"
        ElseIf j = 5 Then
        xlRng.cells(i + 1, j) = "Mardi"
        ElseIf j = 7 Then
        xlRng.cells(i + 1, j) = "Mercredi"
        ElseIf j = 9 Then
        xlRng.cells(i + 1, j) = "Jeudi"
        ElseIf j = 11 Then
        xlRng.cells(i + 1, j) = "Vendredi"
        ElseIf j = 13 Then
        xlRng.cells(i + 1, j) = "Samedi"
        End If
        xlRng.cells(i + 2, j) = "Shift 1 S"
        xlRng.cells(i + 3, j) = "Shift 1 F"
        xlRng.cells(i + 4, j) = "Shift 2 S"
        xlRng.cells(i + 5, j) = "Shift 2 F"
        xlRng.cells(i + 6, j) = "Shift 3 S"
        xlRng.cells(i + 7, j) = "Shift 3 F"
        xlRng.cells(i + 8, j) = "Shift 4 S"
        xlRng.cells(i + 9, j) = "Shift 4 F"
        xlRng.cells(i + 10, j) = "Shift 5 S"
        xlRng.cells(i + 11, j) = "Shift 5 F"
        
        xlRng.cells(i + 2, j + 1) = BC.WeekDays(k).Shift1.Start
        xlRng.cells(i + 3, j + 1) = BC.WeekDays(k).Shift1.Finish
        xlRng.cells(i + 4, j + 1) = BC.WeekDays(k).Shift2.Start
        xlRng.cells(i + 5, j + 1) = BC.WeekDays(k).Shift2.Finish
        xlRng.cells(i + 6, j + 1) = BC.WeekDays(k).Shift3.Start
        xlRng.cells(i + 7, j + 1) = BC.WeekDays(k).Shift3.Finish
        xlRng.cells(i + 8, j + 1) = BC.WeekDays(k).Shift4.Start
        xlRng.cells(i + 9, j + 1) = BC.WeekDays(k).Shift4.Finish
        xlRng.cells(i + 10, j + 1) = BC.WeekDays(k).Shift5.Start
        xlRng.cells(i + 11, j + 1) = BC.WeekDays(k).Shift5.Finish

        j = j + 2
        k = k + 1
        DoEvents
        Loop While k < 8
        i = i + 12
    Next BC

    I'm happy I found a solution, but it may not be the most efficient  ;)

    4 hours 29 minutes ago