Calculate the number of workdays between two dates in HOURS - vba

Question

I have a code that I found on microsoft website :
Function Work_Days(BegDate As Variant, EndDate As Variant) As Integer
Dim WholeWeeks As Variant
Dim DateCnt As Variant
Dim EndDays As Integer
On Error GoTo Err_Work_Days
BegDate = DateValue(BegDate)
EndDate = DateValue(EndDate)
WholeWeeks = DateDiff("w", BegDate, EndDate)
DateCnt = DateAdd("ww", WholeWeeks, BegDate)
EndDays = 0
Do While DateCnt <= EndDate
If Format(DateCnt, "ddd") <> "Sun" And _
Format(DateCnt, "ddd") <> "Sat" Then
EndDays = EndDays + 1
End If
DateCnt = DateAdd("d", 1, DateCnt)
Loop
Work_Days = WholeWeeks * 5 + EndDays
Exit Function
Err_Work_Days:
' If either BegDate or EndDate is Null, return a zero
' to indicate that no workdays passed between the two dates.
If Err.Number = 94 Then
Work_Days = 0
Exit Function
Else
' If some other error occurs, provide a message.
MsgBox "Error " & Err.Number & ": " & Err.Description
End If
End Function
It works fine, but I would like to get the difference in hours, but it's not working. I Changed the "d" for "h", but instead of giving me the exact hours, it's giving me 24 hours.
When I change "d" for "h" and multiply 1 by 24, and 5 by 24, I dont get the exact difference in hours. This is what I get :
Date1 Date2 DIFFERENCE
2022-05-05 09:05:19; 2022-05-05 15:45:14; 24
it's giving me 24h instead of 6h

Answer 1

The Work_Days function returns the number of weekdays as a whole number. Time is not considered.
This code returns weekday hours between two dates with a time component.
Option Explicit
Function Weekday_Hours(BegDateTime As Variant, EndDateTime As Variant) As Long
' Weekday hours between two dates with a time component
Dim WholeWeeks As Long
Dim DateCurrent As Date
Dim BegDate As Date
Dim EndDate As Date
Dim BegTime As Date
Dim EndTime As Date
Dim EndDays As Long
Dim Week_Days As Long
Dim FirstDay_Hours As Long
Dim LastDay_Hours As Long
Dim FirstDay_Minutes As Long
Dim LastDay_Minutes As Long
' If the weekend, move the start date to Monday 12AM
If Weekday(BegDateTime) = vbSaturday Then ' 7 - Saturday
Debug.Print Weekday(BegDateTime) & ": Saturday"
BegDateTime = DateAdd("d", 1, BegDateTime)
BegDateTime = Format(BegDateTime, "yyyy-mm-dd")
Debug.Print " BegDateTime:" & Format(BegDateTime, "yyyy-mm-dd hh:nn:ss")
End If
If Weekday(BegDateTime) = vbSunday Then ' 1 - Sunday
Debug.Print Weekday(BegDateTime) & ": Sunday"
BegDateTime = DateAdd("d", 1, BegDateTime)
BegDateTime = Format(BegDateTime, "yyyy-mm-dd")
Debug.Print " BegDateTime:" & Format(BegDateTime, "yyyy-mm-dd hh:nn:ss")
End If
BegDate = DateValue(BegDateTime)
Debug.Print " BegDate: " & BegDate
EndDate = DateValue(EndDateTime)
Debug.Print " EndDate: " & EndDate
If BegDate >= EndDate Then
Debug.Print "Adjusted BegDate >= EndDate"
Weekday_Hours = 0
Exit Function
Else ' (BegDate < EndDate)
FirstDay_Hours = DateDiff("h", BegDateTime, BegDate + 1)
Debug.Print " FirstDay_Hours: " & FirstDay_Hours
FirstDay_Minutes = DateDiff("n", BegDateTime, BegDate + 1)
Debug.Print "FirstDay_Minutes: " & FirstDay_Minutes
BegDateTime = DateAdd("d", 1, BegDateTime)
BegDateTime = Format(BegDateTime, "yyyy-mm-dd")
BegDate = DateValue(BegDateTime)
End If
EndTime = TimeValue(EndDateTime)
Debug.Print " BegDateTime: " & Format(BegDateTime, "yyyy-mm-dd hh:nn:ss")
EndDate = DateValue(EndDateTime)
EndTime = TimeValue(EndDateTime)
Debug.Print " EndDateTime: " & EndDate & " " & EndTime
WholeWeeks = DateDiff("w", BegDate, EndDate)
Debug.Print " " & " WholeWeeks: " & WholeWeeks
DateCurrent = DateAdd("ww", WholeWeeks, BegDate)
Debug.Print " DateCurrent: " & DateCurrent
Do While DateCurrent < EndDate
If Weekday(DateCurrent) <> vbSunday And _
Weekday(DateCurrent) <> vbSaturday Then
EndDays = EndDays + 1
Debug.Print " EndDays: " & EndDays
Else
DateCurrent = Format(DateCurrent, "yyyy-mm-dd")
End If
DateCurrent = DateAdd("d", 1, DateCurrent)
Debug.Print " DateCurrent: " & Format(DateCurrent, "yyyy-mm-dd hh:nn:ss")
Loop
Week_Days = WholeWeeks * 5 + EndDays
Debug.Print " Week_Days: " & Week_Days
Debug.Print " Whole day hours: " & Week_Days * 24
BegTime = TimeValue(BegDateTime)
Debug.Print " BegDateTime: " & BegDate & " " & BegTime
LastDay_Hours = DateDiff("h", BegTime, EndTime)
Debug.Print " LastDay_Hours: " & LastDay_Hours
LastDay_Minutes = DateDiff("n", BegTime, EndTime)
Debug.Print " LastDay_Minutes: " & LastDay_Minutes
' Weekday hours
Weekday_Hours = FirstDay_Hours + Week_Days * 24 + LastDay_Hours
Debug.Print " Weekday_Hours: " & Weekday_Hours
Weekday_Hours = (FirstDay_Minutes + LastDay_Minutes) / 60 + Week_Days * 24
Debug.Print " Weekday_Hours: " & Weekday_Hours
End Function
Private Sub Weekday_Hours_test()
Dim BegDateTime As Variant
Dim EndDateTime As Variant
' Whole day hours: 0
' LastDay_Hours: 6
' LastDay_Minutes: 400
' Weekday_Hours: 6 / 7 when using minutes
BegDateTime = "2022-05-05 09:05:19"
EndDateTime = "2022-05-05 15:45:14"
' ?
'BegDateTime = "2022-05-05 15:45:14"
'EndDateTime = "2022-05-05 09:05:19"
' Weekday_Hours: 0
'BegDateTime = "2022-04-30 09:05:19" ' Saturday
'EndDateTime = "2022-05-01 15:45:14" ' Sunday
' FirstDay_Hours: 9
' FirstDay_Minutes: 495
' Whole day hours: 0
' LastDay_Hours: 9
' LastDay_Minutes: 545
' Weekday_Hours: 18 / 17 when using minutes
'BegDateTime = "2022-05-04 15:45:14"
'EndDateTime = "2022-05-05 09:05:19"
' FirstDay_Hours: 15
' FirstDay_Minutes: 895
' Whole day hours: 96
' LastDay_Hours: 15
' LastDay_Minutes: 945
' Weekday_Hours: 126 / 127 when using minutes
'BegDateTime = "2022-05-05 09:05:19"
'EndDateTime = "2022-05-12 15:45:14"
' *** Monday starts at 12AM
' FirstDay_Hours: 24
' FirstDay_Minutes: 1440
' Whole day hours: 48
' LastDay_Hours: 15
' LastDay_Minutes: 945
' Weekday_Hours: 87 / 88 when using minutes)
'BegDateTime = "2022-04-30 09:05:19" ' Saturday
'EndDateTime = "2022-05-05 15:45:14"
' FirstDay_Hours: 15
' FirstDay_Minutes: 895
' Whole day hours: 24
' LastDay_Hours: 15
' LastDay_Minutes: 945
' Weekday_Hours: 54 / 55 when using minutes)
'BegDateTime = "2022-05-05 09:05:19"
'EndDateTime = "2022-05-07 15:45:14" ' Saturday
' *** When time is not entered the default is 12AM ***
' Weekday_Hours: ?
'BegDateTime = "2022-05-05"
'EndDateTime = "2022-05-05"
' One day not two
' FirstDay_Hours: 24
' FirstDay_Minutes: 1440
' Weekday_Hours: 24
'BegDateTime = "2022-05-04"
'EndDateTime = "2022-05-05"
' Three days not four
' FirstDay_Hours: 24
' FirstDay_Minutes: 1440
' Whole day hours: 48
' LastDay_Hours: 0
' LastDay_Minutes: 0
' Weekday_Hours: 72
'BegDateTime = "2022-04-30" ' Saturday
'EndDateTime = "2022-05-05"
If EndDateTime > BegDateTime Then
Debug.Print " Weekday_Hours: " & Weekday_Hours(BegDateTime, EndDateTime)
Else
Debug.Print "?"
End If
End Sub