I need to calculate business hours elapsed in MS Excel. Here i have two dates, start and End date with respective timings. Some places i might not have end date and timings. Business hours are 7AM EST - 17 PM EST. how can i calculate number of business hours elapsed here ? (Excluding Weekends)
Tried "=IF(ISBLANK(P2),(NETWORKDAYS(O2,NOW())-1)*("17:00"-"7:00")+IF(NETWORKDAYS(NOW(),NOW()),MEDIAN(MOD(NOW(),1),"17:00","7:00"),"17:00")-MEDIAN(NETWORKDAYS(O2,O2)MOD(O2,1),"17:00","7:00"),(NETWORKDAYS(O2,P2)-1)("17:00"-"7:00")+IF(NETWORKDAYS(P2,P2),MEDIAN(MOD(P2,1),"17:00","7:00"),"17:00")-MEDIAN(NETWORKDAYS(O2,O2)*MOD(O2,1),"17:00","7:00"))", need to exclude holidays as well here.
You can split this into three components (fraction of first day, full workdays, fraction of last day)
Lets start with the middle part. Here you can use NETWORKDAYS and subtract the start and end date. I am assuming a start date in A1 and end date in B1. In order to exclude holidays you need to maintain a list of holidays in your sheet. The formula assumes that this list is in range C1:C10. The results is multiplied by 10 as there are 10 hours in your workday.
=MAX((NETWORKDAYS(A1,B1,C1:C10)-NETWORKDAYS(A1,A1,C1:C10)-NETWORKDAYS(B1,B1,C1:C10))*10,0)
For the fractions you will need to determine if the day itself is a holiday, we use the NETWORKDAYS function again as a factor which will be either 0 or 1. Now we only need to determine the hours to add for the day. Depending on the granularity you want you can consider hours, minutes or even seconds. I will use hours and minutes as a fraction (minutes/60 = hours).
For the first day you get
=MAX(17-MAX(HOUR(A1)+MINUTE(A1)/60,10),0)*NETWORKDAYS(A1,A1,C1:C10)
For the last day you get
=MAX(MIN(HOUR(B1)+MINUTE(B1)/60,17)-10,0)*NETWORKDAYS(B1,B1,C1:C10)
Putting it all together leaves us with:
=MAX(17-MAX(HOUR(A1)+MINUTE(A1)/60,10),0)*NETWORKDAYS(A1,A1,C1:C10)+MAX((NETWORKDAYS(A1,B1,C1:C10)-NETWORKDAYS(A1,A1,C1:C10)-NETWORKDAYS(B1,B1,C1:C10))*10,0)+MAX(MIN(HOUR(B1)+MINUTE(B1)/60,10)-10,0)*NETWORKDAYS(B1,B1,C1:C10)
I believe this UDF will do what you need.
It calculates the hours and returns it as a float, then you need to multiply that with 24 to get the hours.
Function workhours(startdate As Date, enddate As Date)
Opentime = "7:00"
Closetime = "17:00"
Fulldays = Int(enddate - startdate) - 1
DayOneHours = CDate(Year(startdate) & "-" & Month(startdate) & "-" & Day(startdate) & " " & Closetime) - startdate
BeforeOpen = CDate(Year(startdate) & "-" & Month(startdate) & "-" & Day(startdate) & " " & Opentime) - startdate
HoursDayOne = DayOneHours - BeforeOpen
If enddate < CDate(Year(enddate) & "-" & Month(enddate) & "-" & Day(enddate) & " " & Opentime) Then
HoursLastDay = 0
Else
HoursLastDay = enddate - CDate(Year(enddate) & "-" & Month(enddate) & "-" & Day(enddate) & " " & Opentime)
End If
workhours = Fulldays * (CDate(Closetime) - CDate(Opentime)) + HoursDayOne + HoursLastDay
End Function
Use it in Excel like:
=workhours(A1,B1)*24
Related
In the code below, we are searching through a list of roughly 500 items to identify which items belong to Rate A and Rate B, then adding the number of hours recorded to a running total.
We also want to set an arbitrary number of rate periods - dividing the total period (approximately 2018 to 2021) into blocks. The first block will always begin before the start of the data and the last block will go right to the end of it.
Rate Period Dialog has a DTPicker object on it.
When we have only 1 rate period, the totals are summed correctly.
When we have 2 rate periods and the date is entered (for example) as 01/01/2020, the first rate period totals appear to be calculated correctly, but the second is lower than it should be.
When we have 2 rate periods and a different date is entered using the DTPicker, where the day is greater than 12 (for example - 13/01/2020), all rate periods are shown as zero for both Rate A and Rate B.
UK date format (dd/mm/yyyy) applies, though this will hopefully not matter (using DTPicker and DateSerial)
Public rateAHours() As Single
Public rateBHours() As Single
Sub DebugSumRateData()
'Define ranges for Work Hours (sumRange), column with rate data (A, B or otherwise) and column with date of work
Dim sumRange As Range
Dim rateRange As Range
Dim dateRange As Range
Dim periodStartDate As Date
Dim periodEndDate As Date
Set dateRange = Range("Data!B:B")
Set rateRange = Range("Data!E:E")
Set sumRange = Range("Data!F:F")
'Setup dates for rate period
numberOfRatePeriods = InputBox("How many rate periods apply to this schedule?", "Number of Rate Periods")
'Set all arrays to the size required for the number of rate periods
ReDim endDates(numberOfRatePeriods) As Date
ReDim rateAHours(numberOfRatePeriods) As Single
ReDim rateBHours(numberOfRatePeriods) As Single
If (numberOfRatePeriods > 1) Then
For i = 1 To numberOfRatePeriods - 1
RatePeriodDialog.DatePromptLabel = "Please enter end date of rate period " & i
RatePeriodDialog.Show
endDates(i) = ratePeriodInputDate
Next i
End If
'Final rate period is until end of time (or near enough)
endDates(numberOfRatePeriods) = DateSerial(9999, 1, 1)
periodStartDate = DateSerial(1900, 1, 1)
For i = 1 To UBound(endDates)
periodEndDate = endDates(i)
MsgBox "Start of loop " & i & " - Start Date is " & periodStartDate & " End Date is " & periodEndDate
rateAHours(i) = WorksheetFunction.SumIfs(sumRange, rateRange, "A", dateRange, ">=" & periodStartDate, dateRange, "<=" & periodEndDate)
rateBHours(i) = WorksheetFunction.SumIfs(sumRange, rateRange, "B", dateRange, ">=" & periodStartDate, dateRange, "<=" & periodEndDate)
periodStartDate = DateAdd("d", 1, periodEndDate)
MsgBox "End of loop " & i & " - Start Date is " & periodStartDate & " End Date is " & periodEndDate
'Debug Message Box - shows all rate totals for this loop
MsgBox rateAHours(i) & vbCrLf & _
rateBHours(i) & vbCrLf
Next i
End Sub
When entering 1 rate period, all work hours at Rate A and Rate B are calculated and stored in the array
(Debug Message Box at end of Loop reports 75.5 and 7.2)
When using 2 or more rate periods, work hours are inconsistent - some missing in each case
(2 rate periods, date for end of Rate Period of 01/01/2020 - Debug Message Box reports 49 and 7.1 (1st Loop) & 22.3 and 0.1 (2nd Loop))
Where the day element of an "end of period" date is greater than 12, all sums return as 0 from WorksheetFunction.SumIfs (checked in VBA debug stepthrough)
(2 rate periods, date for end of Rate Period of 13/01/2020 - Debug Message Box reports 0 and 0 (both loops)
On the edge case where the end of rate period is 12/01/2020, acts as though all data was before this date (2 rate periods, date for end of Rate Period of 12/01/2020 - Debug Message Box reports 75.5 and 7.2 (1st Loop) & 0 and 0 (2nd Loop) - data continues until Jan 2021, with many items for Rate A and B
Debug messages at start and end confirm correct dates being used for the SumIfs in each loop
You should convert the dates to Long integers using CLng - for example:
rateAHours(i) = WorksheetFunction.SumIfs(sumRange, rateRange, "A", dateRange, ">=" & CLng(periodStartDate), dateRange, "<=" & CLng(periodEndDate))
I am trying to calculate time difference in hours between two times.
But i am not getting the exspected result, as a matter of fact the same function
throws me two different results.
time between 14:22:00 and 22:57:48 should come as 8 hours 35 minutes and 48 sec.
However i get two different numbers.
If i store the value as a date i get 14:19:12
If i calculate in a msgbox on the go i get 8,5966...
Neither is correct, or maybe it is using some sort of format i am unaware of.
Screenshot shows both the msgbox and the storage test.
Also posted in exspected result.
Any suggestions?
Public Sub DDtest()
Dim EDay As Date
Dim ETime As Date
Dim DtgA As Date
EDay = Format(CDate(Replace(Worksheets("Data2020").Range("E2").Value, ".", "/")), "dd-mmm-yyyy")
ETime = Format(Worksheets("Data2020").Range("F2"), "hh:mm:ss")
DtgA = EDay + ETime
Dim EDay2 As Date
Dim ETime2 As Date
Dim DtgB As Date
EDay2 = Format(CDate(Replace(Worksheets("Data2020").Range("E3").Value, ".", "/")), "dd-mmm-yyyy")
ETime2 = Format(Worksheets("Data2020").Range("F3"), "hh:mm:ss")
DtgB = EDay2 + ETime2
Dim result As Date
result = Format(DateDiff("s", DtgA, DtgB) / (60 * 60), "hh:mm:ss")
MsgBox "Date 1:" & DtgA & vbNewLine & "Date 2:" & DtgB & vbNewLine & vbNewLine & DateDiff("s", DtgA, DtgB) / (60 * 60) & vbNewLine & result
End Sub
DateDiff("s", DtgA, DtgB) / (60 * 60) will return a decimal value, in this case is 8.59666666666667 hours
When you apply Format to convert it into hh:mm:ss, the value 8.59666666666667 is not being treated as hours. Excel thinks it's a decimal value that must be converted into date, and it's being treated as days.
In Excel, Dates are always numbers. Integer part is the date itself, while decimal part is time, a part of that day but not the day itself.
First day Excel can use is 01/01/1900 and numeric value is 1, 2 is 02/01/1900 and so on.
So Excel thinks 8.59666666666667 is 08/01/1900 14:19:12
If you divide those hours between 24, you will get the right result:
result = Format(DateDiff("s", DtgA, DtgB) / (60 * 60) / 24, "hh:mm:ss")
You get this:
Note the first value is decimal value and the second one is formatted as hh:mm:ss. But both of them show the same value, with different format.
UPDATE: Actually, if you force your dates values to make a difference of 8 and a half hours exactly, you will see perfectly how Excel works. Same value but with different format.
I've forced dates to be 12/12/2019 14:22:00 and 12/12/2019 22:52:00 and I get this:
Exactly 8 hours and a half, but first in decimal and second is format hh:mm:ss.
Why are you formatting before calculation? If cell value is date formatting doesn't meter.
date & time = 441040.598611111111111
Sub calcDatediff()
date1 = Worksheets("masterdata").Range("C11")
time1 = Worksheets("masterdata").Range("D11")
date2 = Worksheets("masterdata").Range("C12")
time2 = Worksheets("masterdata").Range("D12")
dtime1 = date1 + time1
dtime2 = date2 + time2
difftime = Format(dtime2 - dtime1, "HH:mm:ss", vbMonday, vbFirstFourDays)
End Sub
I am currently working on a excel macro which generates Weekly data. I have to prepare multiple reports where my Week starting day is different e.g. if for one report my week start day is "Friday" whereas for other report the week start day is "Monday"
Right now, I am doing this in multiple steps:
First I am getting all data from source excel and adding a formula to get all records in a particular week. I have considered "Friday" as my first day of week.
I arranged the records in descending order and get the unique value for each AZ column. This way I got the last record from each week, which is what I was looking.
Code I am using for this is as follows:
Range("Data").AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=Range("$A$1:$A$2"), _
CopyToRange:=Range("$BB$4:$BD$4")
FilterDataLastRow = Cells.Find(What:="*", _
After:=Range("BA999999"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
' Sort data in descending order of date
' Range("WeeklyFilteredData").Sort Key1:=Range("$BB$4:$BB$999999"), Order1:=xlDescending, Header:=xlYes
Range("AW4:BE999999").Sort Key1:=Range("BC4:BC999999"), order1:=xlDescending, Header:=xlYes
' Assign Unique Key for each record row. We are using RowNum for same
Range("BA5:BA" & FilterDataLastRow).Formula = "=ROW(RC[-2])"
' Assign SearchKey to filter Out all the data belonging to same week
Range("AZ5:AZ" & FilterDataLastRow).Formula = "=(TEXT(RC[3],""yyyy""))&(TEXT(WEEKNUM(RC[3],15),""00""))"
' Get all data in User View
Range("A5:A" & FilterDataLastRow).Formula = "=VLOOKUP(RC[51],C[51]:C[55],2,FALSE)"
Range("B5:B" & FilterDataLastRow).Formula = "=VLOOKUP(RC[50],C[50]:C[54],3,FALSE)"
Range("C5:C" & FilterDataLastRow).Formula = "=VLOOKUP(RC[49],C[49]:C[53],4,FALSE)"
Range("E5:E" & FilterDataLastRow).Formula = "=VLOOKUP(RC[47],C[47]:C[51],5,FALSE)"
Cells.RemoveDuplicates Columns:=Array(1)
This was working perfectly fine till WEEKNUM 53. January 2020 started on Wednesday and this was considered a WEEKNUM "1" which is not correct for my report.
Currently I am getting my Output as shown below:
I need to modify my Code to skip data for 12/31/2019 (Highlighted in red) as this data will be calculated as part of week which is ending on 01/02/2020.
Please suggest a better way to update my code to enter code here
[Update: 07 January 2020] ANSWER
I figured out a way to achieve my end result. But I know there is still better way to do same thing and hence I am keeping this question open for better approach.
Here is what I did:
1. Retrieve MONTH, DAY and WEEKDAY from given date
Range("AW5:AW" & FilterDataLastRow).Formula = "=MONTH(RC[6])"
Range("AX5:AX" & FilterDataLastRow).Formula = "=DAY(RC[5])"
Range("AY5:AY" & FilterDataLastRow).Formula = "=WEEKDAY(RC[4],16)"
Now added a for loop. I tried to explain each of my step in comments inside code.
For i = 5 To FilterDataLastRow
' Check for records with Month = 1 And DAY is 1-6 and WEEKDAY < 6
If Range("AW" & i).Value = 1 And Range("AX" & i).Value < 7 Then
CurrYear = Year(Range("BC" & i).Value)
PrevYear = CurrYear - 1
PrevYearLastDay = "12/31/" & PrevYear
Range("AV" & i).Value = PrevYearLastDay
'Get the Day of Weel on 31st December of Previous Year
Range("AU" & i).Value = "=WEEKDAY(RC[1],16)"
'Calculate Number of Days remaining for new week to start
DaysRemForNewWeek = 8 - Range("AU" & i).Value
'Calculate Date of First Friday of Current Year
Range("AT" & i).Value = PrevYearLastDay + DaysRemForNewWeek
'Compare all the dates prior to first Friday and rollover WeekNum from last year for these dates
If Range("BC" & i).Value < Range("AT" & i).Value Then
Range("AZ" & i).Formula = "=(TEXT(RC[-4],""yyyy""))&(TEXT(WEEKNUM(RC[-4],16),""00""))"
Else
Range("AZ" & i).Formula = "=(TEXT(RC[3],""yyyy""))&(TEXT(WEEKNUM(RC[3],16),""00""))"
End If
Else
Range("AZ" & i).Formula = "=(TEXT(RC[3],""yyyy""))&(TEXT(WEEKNUM(RC[3],16),""00""))"
End If
Next i
What is your definition of a Week given a particular start day?
If it is the first full week of the year starting with that date, then you can derive it more easily from the VBA DatePart function, e.g
DatePart("ww", myDate, vbFriday, vbFirstFullWeek)
If you need to have this as a function or part of a formula on your worksheet, use it as a UDF instead of the worksheet WEEEKNUM function which is not as flexible. Or, better yet, construct the year/wknum string in VBA using the vba Format function and write that string to the worksheet.
For example:
Function yrWkNum(dt As Date) As String
yrWkNum = Year(dt) & Format(DatePart("ww", dt, vbFriday, vbFirstFullWeek), "00")
End Function
I figured out a way to achieve my end result. But I know there is still better way to do same thing and hence I am keeping this question open for better approach.
Here is what I did:
1. Retrieve MONTH, DAY and WEEKDAY from given date
Range("AW5:AW" & FilterDataLastRow).Formula = "=MONTH(RC[6])"
Range("AX5:AX" & FilterDataLastRow).Formula = "=DAY(RC[5])"
Range("AY5:AY" & FilterDataLastRow).Formula = "=WEEKDAY(RC[4],16)"
Now added a for loop. I tried to explain each of my step in comments inside code.
For i = 5 To FilterDataLastRow
' Check for records with Month = 1 And DAY is 1-6 and WEEKDAY < 6
If Range("AW" & i).Value = 1 And Range("AX" & i).Value < 7 Then
CurrYear = Year(Range("BC" & i).Value)
PrevYear = CurrYear - 1
PrevYearLastDay = "12/31/" & PrevYear
Range("AV" & i).Value = PrevYearLastDay
'Get the Day of Weel on 31st December of Previous Year
Range("AU" & i).Value = "=WEEKDAY(RC[1],16)"
'Calculate Number of Days remaining for new week to start
DaysRemForNewWeek = 8 - Range("AU" & i).Value
'Calculate Date of First Friday of Current Year
Range("AT" & i).Value = PrevYearLastDay + DaysRemForNewWeek
'Compare all the dates prior to first Friday and rollover WeekNum from last year for these dates
If Range("BC" & i).Value < Range("AT" & i).Value Then
Range("AZ" & i).Formula = "=(TEXT(RC[-4],""yyyy""))&(TEXT(WEEKNUM(RC[-4],16),""00""))"
Else
Range("AZ" & i).Formula = "=(TEXT(RC[3],""yyyy""))&(TEXT(WEEKNUM(RC[3],16),""00""))"
End If
Else
Range("AZ" & i).Formula = "=(TEXT(RC[3],""yyyy""))&(TEXT(WEEKNUM(RC[3],16),""00""))"
End If
Next i
I have a cell with a date:
30/04/1991
I need to make a compare with today's date, but with day and month of that cell, but with current year. But it isn't working.
I have the following:
MsgBox Format(Day(cell.Value) & "/" & Month(cell.Value) & "/" & Year(Now), "dd/mm/yyyy") < Format(Now, "dd/mm/yyyy")
The result is "30/04/2017 < 01/05/2017"
But msgbox result is "False". Which is wrong, given today's date as "01/05/2017"
What am I doing wrong?
To avoid issues with February 29th, you can compare just the month and date:
MsgBox Format(cell, "mmdd") < Format(Now, "mmdd")
Update
DatePart("y", Date) can be used to get the Day of year:
MsgBox DatePart("y", cell) < DatePart("y", Now)
Debug.Print DatePart("y", "2 28") // 59
Debug.Print DatePart("y", "2 29 16") // 60
I would recommend using DateDiff fuinction.
You can use Date instead of Now since you only need the date, and not the time.
If you use DateDiff you can keep the 2 values as Date variable, and instead of using DateValue with some & and "/", you can have a shorter and cleaner version DateSerial(Year(Date), Month(cell.Value), Day(cell.Value)).
Code:
MsgBox DateDiff("d", DateSerial(Year(Date), Month(cell.Value), Day(cell.Value)), Date) > 1
If you want to get also the number of days between these 2 dates:
MsgBox DateDiff("d", DateSerial(Year(Date), Month(cell.Value), Day(cell.Value)), Date)
I solved by myself with
MsgBox DateValue(Day(cell.Value) & "/" & Month(cell.Value) & "/" & Year(Now)) < DateValue(Date)
I'm using this formulas:
=DATEDIF(B9,S9,"d") & " Days " & TEXT(S9-B9, "h:m") & " hrs:min"
=DATEDIF(B10,S10,"d") & " Days " & TEXT(S10-B10, "h:m") & " hrs:min"
etc..
And now i need to have a formula that calculates the average of those dates. The problem is that they are in text and excel cannot calculate average.. Would appreciate any input. Thanks
Your formula isn't a reliable method for calculating days and hours between two dates. Consider where B9 is 1st Jan 2013 at 22:00 and S9 is the next day 2nd Jan at 06:00 - there are only 8 hours between those two "timestamps" but your formula will give the result
1 Days 8:00 hrs:min
better to use this version
=INT(S9-B9) & " Days " & TEXT(S9-B9, "h:m") & " hrs:min"
That will give correct results in all cases
For the average you can use a formula like this
=INT(AVERAGE(S9:S18)-AVERAGE(B9:B18)) & " Days " & TEXT(AVERAGE(S9:S18)-AVERAGE(B9:B18), "h:m") & " hrs:min"
where you have data in rows 9 to 18
Consider the following:
Formulas:
C2 = B2-A2
(same for rows 2 through 6)
C7 = AVERAGE(C2:C6)
D2 = INT(C2) & " Days " & TEXT(C2, "h:mm") & " hrs:min"
(same for rows 2 through 7)