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?
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
hopefully this is a silly question with an easy answer.
I have no choice really what language I use, which is why I'm doing this in Excel with VBA.
I'm basically calculating total downtime hours over a month. I need to add small amounts of minutes together to find out a total that will be over 24 hours of course.
Here is the scenario:
Server A was down for 3 hours and 52 minutes this month.
Server B was down for 15 hours and 25 minutes this month.
Server B had 7 hours and 23 minutes downtime during a critical period, so this is multplied by 3 to equate it to non-critical downtime.
Server A has: 3 hours 52 minutes at x1
Server B has: 8 hours 2 minutes at x1
Server B has: 7 hours 21 minutes at x3
All downtimes and restoration times are manually listed in a sheet in time formats recognised by excel, eg:
event 1 : 19/11/2017 5:00 : 19/11/2017 14:12
event 2 : 13/11/2017 6:00 : 13/11/2017 6:40
event 3 : 13/11/2017 7:57 : 13/11/2017 9:01
event 4 : 17/11/2017 6:15 : 18/11/2017 8:10
Weekends are not counted
Only minutes between 6am and 6pm are counted
Minutes increase in priority during certain time periods:
06:00-07:00, 07:00-09:00, 09:00-10:00, 10:00-14:00
High priority minutes are multiplied to equate peak time usage with lower standard time usage
I'm struggling to find a way to add times together to count hours, excel trys to give answers relative to 01/01/1900 or some "real" date.
I'm going the opposite way, I have the real dates, I need to work with the hours between them. Is there a data format that is in plain hours:minutes?
I thought it was obvious but I'll state clearly in case, start time and end times are not necessarily on the same day. They can be any time, any relationship, sometimes start time will be after the end time due to how faults are reported. Obviously that counts as 0 minutes in that case.
My current methodology for attacking this problem is:
increase the start time until it becomes valid charge time
calculate the minutes until there is a change such as end of day or higher priority time slot, or start time = end time
add the calculated minutes to a total
increase the start time by the calculated minutes
start cycle again from the the new 'start time' and loop until there are no minutes remaining between start time and end time
startof:
'move to start of next chargeable day, if not on a chargeable day
'eg weekends, public holidays, easy function to write
Do While testForChargeable() = False
opnDate = DateAdd("d", 1, opnDate)
opnTime = "06:00"
Loop
'check if open time is past the end of chargeable time, 18:00
If (opnTime >= endofdayTime) Then
'move to start of next chargeable day
opnDate = DateAdd("d", 1, opnDate)
opnTime = "06:00"
End If
'check if open time is after close time and fault is excluded
If (opnDate >= bisDate) And (opnTime >= bisTime) Then
GoTo last
End If
'check if close time is on same day as start time
If DateDiff("d", opnDate, bisDate) = 0 Then
'if it is, add minutes between opntime and bistime
chargeTime = chargeTime + calculateChargeTime(opnTime, bisTime)
'calculation ends, loop naturally terminates
Else
'if not, add remaining mintes of day to chargeable time
chargeTime = chargeTime + calculateChargeTime(opnTime, endofdayTime)
'move to start of next day
opnDate = DateAdd("d", 1, opnDate)
opnTime = "06:00"
GoTo startof
End If
last:
Cheers
Edit: Now that we're on the same page and I have what I think is a workable solution for you, I'll replace my previous answer [re: How Excel dates are related to value (ie., 1 day = 1)] with this one. The previous answer (and my computer messing up while trying to post it) is viewable in the Edit History.
So, you need a way to count minutes duration, between two DateTimes, and include or exclude sub-time-ranges based on criteria that might require ongoing adjustment, and you want this in a VBA function for use in automation of downtime data analysis.
Try this:
Option Explicit
Function MinsBetween(startDateTime As Date, stopDateTime As Date, count_StartTime As Date, count_StopTime As Date) As Long
Dim startTime As Date, stopTime As Date
'ignore dates, use only the times
startTime = startDateTime - Int(startDateTime)
stopTime = stopDateTime - Int(stopDateTime)
If startTime >= count_StopTime Or stopTime <= count_StartTime Then
'entire period falls outside of times to count
MinsBetween = 0
Exit Function
End If
'make 'adj' times start/end at counted times if necessary
startDateTime = IIf(startTime < count_StartTime, count_StartTime, startTime)
stopDateTime = IIf(stopTime > count_StopTime, count_StopTime, stopTime)
'calculate & return minutes between (never return negative number)
MinsBetween = Abs(DateDiff("n", startDateTime, stopDateTime))
End Function
This function counts only the minutes between startDateTime and stopDateTime that also fall between count_StartTime and count_StopTime.
Expects:
- count_StartTime & count_StopTime to be an Excel Time (or number between 0 and 1)
- startDateTime & stopDateTime to be an Excel Time or DateTime.
Returns a long integer. Could be referenced in VBA or as a worksheet function.
Example usage:
The outage 'event' occurred from 05:00 to 07:03 on 2017/11/19, but only the times between 6am and 6pm should be counted:
Debug.Print MinsBetween("2017/11/19 05:00", "2017/11/19 07:03", "06:00", "18:00")
The outage 'event' occurred from 05:00 to 14:12 on 2017/11/19. The duration that occurred between [peak period] 1pm to 2pm are have higher priority and should be counted as "double-time":
Debug.Print (2 * MinsBetween("2017/11/19 05:00", "2017/11/19 14:12", "13:00", "15:00") )
As weekends are ignored entirely, those reports could be excluded with a simple check like this:
Function isWeekend(wDateTime As Date) As Boolean
isWeekend = Weekday(DateValue(wDateTime)) = vbSaturday Or Weekday(DateValue(wDateTime)) = vbSunday
End Function
...returns TRUE if the supplied date (or datetime) falls on a weekend, otherwise returns FALSE.
You could use a combination of these functions to build sub or worksheet function around your custom criteria and adjust as needed.
For example:
Function DownTimeMinutes(startDateTime As Date, stopDateTime As Date) As Long
'you could process your custom criteria for each start/stop period here
Dim dtMinutes As Long
'for example:
'IGNORE DOWNTIME ON WEEKENDS
If isWeekend(startDateTime) Then
'ignore weekeends
DownTimeMinutes = 0
Exit Function
End If
'COUNT MINUTES BETWEEN 6AM-6PM with "x1" multiplier
dtMinutes = MinsBetween(startDateTime, stopDateTime, "06:00", "18:00")
'DON'T COUNT LUNCH BREAK (or something like that)
'(subtract these minutes from total)
dtMinutes = dtMinutes - MinsBetween(startDateTime, stopDateTime, "12:00", "12:30")
'COUNT MINUTES BETWEEN 14:00-15:00 as "x3"
'(already counted as "x1" so add "2x these minutes"
dtMinutes = dtMinutes + (2 * MinsBetween(startDateTime, stopDateTime, "14:00", "15:00"))
'return adjusted minutes for this downtime event
DownTimeMinutes = dtMinutes
End Function
Side note: This is the short-story of the long-example I was getting at when I thought part of your issue was trouble converting varying M/D/Y , MM/DD/YY , M-DD-YYYY , etc, manual entries to DateTimes that Excel would recognize regardless of the user's Regional date settings.
As I understand it, you don't need it now but I figured I might as well add it to my answer anyway :
=DATE(MID(RIGHT(LEFT(A1,FIND(" ",A1)-1),LEN(LEFT(A1,FIND(" ",A1)-1))-FIND("/",LEFT(A1,FIND(" ",A1)))),FIND("/",RIGHT(LEFT(A1,FIND(" ",A1)-1),LEN(LEFT(A1,FIND(" ",A1)-1))-FIND("/",LEFT(A1,FIND(" ",A1)))))+1,4),LEFT(RIGHT(LEFT(A1,FIND(" ",A1)-1),LEN(LEFT(A1,FIND(" ",A1)-1))-FIND("/",LEFT(A1,FIND(" ",A1)))),FIND("/",RIGHT(LEFT(A1,FIND(" ",A1)-1),LEN(LEFT(A1,FIND(" ",A1)-1))-FIND("/",LEFT(A1,FIND(" ",A1)))))-1),FIND("/",RIGHT(LEFT(A1,FIND(" ",A1)-1),LEN(LEFT(A1,FIND(" ",A1)-1))-FIND("/",LEFT(A1,FIND(" ",A1))))))+TIMEVALUE(RIGHT(A1,LEN(A1)-FIND(" ",A1)))
Generally I don't condone the use of gigantic formulas (I was more concerned about getting it into a single function that about readability), and there are other ways to deal with date issues caused by Regional differences in shared workbooks (including Windows API) but in most cases I find text manipulation will do the job too.
How do I subtract Time in Excel VBA?
I tried to subtract these two values, but I'm getting this value "2.1527777777778E-02" instead. What does this mean?
Timein = 12/7/16 12:00:00 AM
Timeout = 12/7/16 12:30:00 AM
Here's a sample of my code. Thanks in advance.
Dim Total as Double
Dim Timein as Date
Dim Timeout as Date
Total = TimeValue(Timeout) - TimeValue(Timein)
'Result Total=2.1527777777778E-02
You can use the DateDiff Function to get the difference in year/days/seconds or whatever.
Here the example for minutes.
Dim Timein As Date
Dim Timeout As Date
Timein = "12/7/16 12:00:00 AM"
Timeout = "12/7/16 12:30:00 AM"
Debug.Print DateDiff("n", Timein, Timeout)
Output:
30
Interval Explanation
yyyy Year
q Quarter
m Month
y Day of year
d Day
w Weekday
ww Week
h Hour
n Minute
s Second
What you have done is perfectly correct, as can be seen by the following code:
Sub test()
Dim Total As Double
Dim Timein As Date
Dim Timeout As Date
Timein = CDate(Range("A1").Value)
Timeout = CDate(Range("A2").Value)
Total = TimeValue(Timeout) - TimeValue(Timein)
Debug.Print Total
Debug.Print Format(Total, "hh:mm:ss")
Range("A3").NumberFormat = "hh:mm:ss"
Range("A3").Value = Total
Debug.Print "Number of hours = " & Total * 24
End Sub
As mentioned by vacip in a comment, Date/Time variables are stored in VBA in "days" so, for example, Now for me is the number 42867.7513310185.
2.1527777777778E-02 is using a method of displaying a value called Scientific Notation. In your case, it means 2.1527777777778 times 10 to the power of -2. Or you could think of the E-02 part as meaning shift the decimal point two places to the left (left because it's negative).
So: 0.021527777777778.
Excel treats time (both dates and times of day) as whole days so half a day (12 hours) would be represented as 0.5.
So the result itself represents the decimal fraction of an entire day, if you want this in minutes for example, you would multiply the value by 1440 (24hr x 60min make a day) which would give you 31mins.
In your example, you're finding the difference between 12:00 and 12:30 so you should actually be getting a result of 2.08333333333333E-02 which if multiplied by 1440 would give you 30mins.
Excel gives you tools to find the difference between two points in time though that take all that complex math(s) away - DateDiff and #holger has given you everything you need there to write your own code.
You have defined the total as double, which returns you number. you need to dim the total as date so that returns you a time.
Dim Total as Date
Dim Timein as Date
Dim Timeout as Date
Total = TimeValue(Timeout) - TimeValue(Timein)
I would like to calculate the time difference between 2 cells and the result showing in the 3rd cell of a MS WORD TABLE.
For instance, cell D2 showing 2pm and D1 showing 1pm and the difference in cell B2
Sub DetermineDuration()
Dim dtDuration As Date
dtDuration = DateDiff("h:mm:ss", D2, D1)
Range("B2").dtDuration
End Sub
Dates can be subtracted like numbers:
Sub DetermineDuration()
Range("B2") = Range("D2") - Range("D1")
End Sub
Make sure to format cell B2 as Time our you will just end up with a floating point number.
You can use the DateDiff function to return a specific interval type, like hours, minutes or seconds, without precision. It returns a regular number, not a time value. In the interval parameter you have to specify a valid interval value. You can learn about the function and see the valid interval values here MS Excel: How to use the DATEDIFF Function (VBA)
yyyy Year
q Quarter
m Month
y Day of year
d Day
w Weekday
ww Week
h Hour
n Minute
s Second
As you can see, "h:mm:ss" is not a valid interval. You can use this format to get the seconds difference:
DateDiff("s", Range("D2"), Range("D1"))
If you want to get a time value, you can convert using the TimeSerial function.
I'm using Excel 2010 and writing a VBA script that needs to do something if the value is a Cell is between now and in 24 hours. I've looked through dozens of topic and couldn't find a way to efficiently do this.
Here are a few things you need to know.
The script looks for the value (Due Date) in a formula range:
Set FormulaRange = ThisWorkbook.Worksheets("Tasks").Range("F5:F35")
On Error GoTo EndMacro:
For Each FormulaCell In FormulaRange.Cells
With FormulaCell
Let's say that F5 has the following value:
3/9/2016 9:50:00 AM
I am then trying to ask it to do "MyMsg = SentMsg" if the value in range F5:F35 is equal to now or in 24 hours.
Below are a few ways I tried it, and have been unsuccessful at doing so.
1. Doesn't work as it does not consider hours and minutes. It does trigger if the date is tomorrow though, but I need it to check for 24 hours, not +1 day).:
If DateValue(CDate(.Value)) >= Date And DateValue(CDate(.Value)) <= (Date + 1) Then
2. Then I tried to Round Down Now() to the last minute (and adding 1440 minutes for a full day) as the script autoruns itself every minute to check for trigger dates using:
If DateValue(CDate(.Value)) >= Date And DateValue(CDate(.Value)) <= ((Round(Now * 1440, 0) +1440) / 1440) Then
2. Doesn't work as it triggers even if there are more than 24 hours, but doesn't if there is more than 30 hours? (This confuses me). This might be due to me using >= Date? I need to make sure it does send a reminder between Today's 0:00 AM and now + 24 hours.
3. I also tried to use the following but the result is the same as number 2:
If DateValue(CDate(.Value)) >= Date And DateValue(CDate(.Value)) <= (Now + TimeSerial(24, 0, 0)) Then
Am I overthinking this? Is there a easier, simpler way to do this, and if not. What am I doing wrong?
I believe one of the problem is that I can't use between Now and Now + something. Because the script removes the trigger if it is past Now(), so it really has to be a general date and now + time.
Any help will be greatly appreciated, I'm completely stuck there.
Thanks,
Francis M.
There are two possible ways to add 24 hours to the current DateTime (i.e. Now) in Excel VBA; code snippet below demonstrates the use of these functions and also includes a sample IF check based on the condition that the date value in cell "A3" is between Now and (Now+24hrs):
Sub Add24h()
' one possible solution to add 24 hrs
Range("A1").Value = Now + TimeSerial(24, 0, 0)
' another possible solution to add 24 hrs
Range("A2") = DateAdd("h", 24, Now)
'sample logical statement to check if the value is in between two of dates
If (Range("A3") >= Now And Range("A3") <= (Now + TimeSerial(24, 0, 0))) Then
' place you code here
End If
End Sub
The same functionality could be achieved by using Excel Worksheet functions, like shown below:
=IF(AND(A3>=NOW(),A3<=NOW()+1),TRUE,FALSE)
Hope this may help.