CODEWITHSUNDEEP
vbams-project
Marko Manenica
Marko Manenica

Reputation: 85

The amount of possible working hours between two dates in MS Project using VBA

Is it possible to return the amount of possible working hours between a start and finish time in MS Project using VBA? For example if the start and end time was from 12pm to 5pm in the same day and there was a lunch break from 12:30p to 1:30pm than the value returned would be 4 hours (instead of the total time passed of 5 hours).

EDIT: Also can you count the total number of shifts (breaks) in a day using VBA?

Upvotes: 1

Views: 735

Answers (1)

Rachel Hettinger
Rachel Hettinger

Reputation: 8442

Question #1: Calculate working hours between two dates

The Microsoft Project application object has a method called DateDifference which does just that--it calculates the working time between two dates and you can optionally supply a calendar object (the project calendar is used by default). The return value is in minutes, so divide by 60 to get hours.

Use the Intermediate Window* to test:

? Application.DateDifference (#3/11/19 12:00 PM#, #3/11/19 5:00 PM#) / 60
 4 
? Application.DateDifference (#3/11/19 12:00 PM#, #3/11/19 5:00 PM#, ActiveProject.BaseCalendars("24 Hours")) / 60
5

Note: The optional Calendar argument is a calendar object, not the name of a calendar and it must be a calendar in use by the active project.

* From the VB Editor, do Ctrl+G to bring up the Intermediate Window.

Question #2: Calculate the number of shifts for a given day

This function will return the number of shifts for a given day for a particular calendar. If no calendar name is supplied, the project calendar is used.

It works by using the fact that booleans can be converted to integers (False = 0, True = -1) to count the number of true expressions. Specifically, if a shift is used, the Start time is returned as a string representation (e.g. "8:00 AM"), but if the shift is not used, it is returned as an integer (0).

Function ShiftCount(d As Date, Optional calendarName As Variant)

    Dim c As Calendar
    If IsMissing(calendarName) Then
        Set c = ActiveProject.Calendar
    Else
        Set c = ActiveProject.BaseCalendars(calendarName)
    End If

    Dim NumShifts As Integer
    With c.Period(d)
        NumShifts = -CInt(VarType(.Shift1.Start) = vbString) _
                   - CInt(VarType(.Shift2.Start) = vbString) _
                   - CInt(VarType(.Shift3.Start) = vbString) _
                   - CInt(VarType(.Shift4.Start) = vbString) _
                   - CInt(VarType(.Shift5.Start) = vbString)
    End With

    ShiftCount = NumShifts

End Function

Upvotes: 3

Related Questions