View Full Version : Date/Time Diff


Vergy39
12-10-2009, 05:55 AM
I have a query for Date/Time Diff and need to tweak it to include only workdays. Can someone please assist. Here is the code:

Function ConvertTimeDifferenceToFormattedString(StringDate As Date) As String
On Error GoTo Err_ConvertTimeDifferenceToFormattedString
Dim newdate As Date
Dim ldays As Variant
Dim lhours As Variant
Dim lminutes As Variant
newdate = StringDate
ldays = Int(CDbl(newdate))
If ldays = 0 Then
ldays = Null
Else
ldays = Format(ldays, "00")
End If
lhours = Hour(newdate)
lhours = Format(lhours, "00")
lminutes = Format(Minute(newdate), "00")
ConvertTimeDifferenceToFormattedString = ldays + " days " & lhours & " hours " & lminutes & " minutes"

Exit_ConvertTimeDifferenceToFormattedString:
Exit Function
Err_ConvertTimeDifferenceToFormattedString:
If Err.Number = 13 Then 'type mismatch
MsgBox "Not recognized as a date. Check format"
Resume Exit_ConvertTimeDifferenceToFormattedString
Else
MsgBox Err.Description
Resume Exit_ConvertTimeDifferenceToFormattedString
End If
End Function

jdraw
12-10-2009, 06:47 AM
I have a query for Date/Time Diff and need to tweak it to include only workdays. Can someone please assist. Here is the code:

Function ConvertTimeDifferenceToFormattedString(StringDate As Date) As String
On Error GoTo Err_ConvertTimeDifferenceToFormattedString
Dim newdate As Date
Dim ldays As Variant
Dim lhours As Variant
Dim lminutes As Variant
newdate = StringDate
ldays = Int(CDbl(newdate))
If ldays = 0 Then
ldays = Null
Else
ldays = Format(ldays, "00")
End If
lhours = Hour(newdate)
lhours = Format(lhours, "00")
lminutes = Format(Minute(newdate), "00")
ConvertTimeDifferenceToFormattedString = ldays + " days " & lhours & " hours " & lminutes & " minutes"

Exit_ConvertTimeDifferenceToFormattedString:
Exit Function
Err_ConvertTimeDifferenceToFormattedString:
If Err.Number = 13 Then 'type mismatch
MsgBox "Not recognized as a date. Check format"
Resume Exit_ConvertTimeDifferenceToFormattedString
Else
MsgBox Err.Description
Resume Exit_ConvertTimeDifferenceToFormattedString
End If
End Function

Here is a function to calculate workdays between 2 dates.
It does NOT deal with Public Holidays.
Hopefully this is helpful to you.

'---------------------------------------------------------------------------------------
' Procedure : ISO_WorkdayDiff
' Author : Gustav
' Created : 11/11/2009
' Purpose : Calculate Workdays between 2 dates (Accessd)
'---------------------------------------------------------------------------------------
' Last Modified:
'
' Inputs: N/A
' Dependency: N/A
'------------------------------------------------------------------------------
'
Public Function ISO_WorkdayDiff( _
ByVal datDateFrom As Date, _
ByVal datDateTo As Date) _
As Long

' Purpose: Calculate number of working days between dates datDateFrom and datDateTo.
' Assumes: 5 or 6 working days per week. Weekend is (Saturday and) Sunday.
'
' Limitation: *** Does not account for public holidays.***
'
' May be freely used and distributed.
' 1999-04-23. Gustav Brock, Cactus Data ApS, Copenhagen ' 2000-10-03. Constants added.
' Option for 5 or 6 working days per week added.

Const cbytWorkdaysOfWeek As Byte = 5

Dim bytSunday As Byte
Dim intWeekdayDateFrom As Integer
Dim intWeekdayDateTo As Integer
Dim lngDays As Long
Dim datDateTemp As Date

' Reverse dates if these have been input reversed.
On Error GoTo ISO_WorkdayDiff_Error

If datDateFrom > datDateTo Then
datDateTemp = datDateFrom
datDateFrom = datDateTo
datDateTo = datDateTemp
End If

' Find ISO weekday for Sunday.
bytSunday = Weekday(vbSunday, vbMonday)

' Find weekdays for the dates.
intWeekdayDateFrom = Weekday(datDateFrom, vbMonday)
intWeekdayDateTo = Weekday(datDateTo, vbMonday)

' Compensate weekdays' value for non-working days (weekends).
intWeekdayDateFrom = intWeekdayDateFrom + (intWeekdayDateFrom = bytSunday)
intWeekdayDateTo = intWeekdayDateTo + (intWeekdayDateTo = bytSunday)

' Calculate number of working days between the two weekdays, ignoring number of weeks.
lngDays = intWeekdayDateTo - intWeekdayDateFrom - (cbytWorkdaysOfWeek * (intWeekdayDateTo < intWeekdayDateFrom))
' Add number of working days between the weeks of the two dates.
lngDays = lngDays + (cbytWorkdaysOfWeek * DateDiff("w", datDateFrom, datDateTo, vbMonday, vbFirstFourDays))

ISO_WorkdayDiff = lngDays

On Error GoTo 0
Exit Function

ISO_WorkdayDiff_Error:

MsgBox "Error " & Err.number & " (" & Err.Description & ") in procedure ISO_WorkdayDiff of Module Module5"

End Function

Vergy39
12-10-2009, 07:09 AM
Here is a function to calculate workdays between 2 dates.
It does NOT deal with Public Holidays.
Hopefully this is helpful to you.

'---------------------------------------------------------------------------------------
' Procedure : ISO_WorkdayDiff
' Author : Gustav
' Created : 11/11/2009
' Purpose : Calculate Workdays between 2 dates (Accessd)
'---------------------------------------------------------------------------------------
' Last Modified:
'
' Inputs: N/A
' Dependency: N/A
'------------------------------------------------------------------------------
'
Public Function ISO_WorkdayDiff( _
ByVal datDateFrom As Date, _
ByVal datDateTo As Date) _
As Long

' Purpose: Calculate number of working days between dates datDateFrom and datDateTo.
' Assumes: 5 or 6 working days per week. Weekend is (Saturday and) Sunday.
'
' Limitation: *** Does not account for public holidays.***
'
' May be freely used and distributed.
' 1999-04-23. Gustav Brock, Cactus Data ApS, Copenhagen ' 2000-10-03. Constants added.
' Option for 5 or 6 working days per week added.

Const cbytWorkdaysOfWeek As Byte = 5

Dim bytSunday As Byte
Dim intWeekdayDateFrom As Integer
Dim intWeekdayDateTo As Integer
Dim lngDays As Long
Dim datDateTemp As Date

' Reverse dates if these have been input reversed.
On Error GoTo ISO_WorkdayDiff_Error

If datDateFrom > datDateTo Then
datDateTemp = datDateFrom
datDateFrom = datDateTo
datDateTo = datDateTemp
End If

' Find ISO weekday for Sunday.
bytSunday = Weekday(vbSunday, vbMonday)

' Find weekdays for the dates.
intWeekdayDateFrom = Weekday(datDateFrom, vbMonday)
intWeekdayDateTo = Weekday(datDateTo, vbMonday)

' Compensate weekdays' value for non-working days (weekends).
intWeekdayDateFrom = intWeekdayDateFrom + (intWeekdayDateFrom = bytSunday)
intWeekdayDateTo = intWeekdayDateTo + (intWeekdayDateTo = bytSunday)

' Calculate number of working days between the two weekdays, ignoring number of weeks.
lngDays = intWeekdayDateTo - intWeekdayDateFrom - (cbytWorkdaysOfWeek * (intWeekdayDateTo < intWeekdayDateFrom))
' Add number of working days between the weeks of the two dates.
lngDays = lngDays + (cbytWorkdaysOfWeek * DateDiff("w", datDateFrom, datDateTo, vbMonday, vbFirstFourDays))

ISO_WorkdayDiff = lngDays

On Error GoTo 0
Exit Function

ISO_WorkdayDiff_Error:

MsgBox "Error " & Err.number & " (" & Err.Description & ") in procedure ISO_WorkdayDiff of Module Module5"

End Function

Thanks for the reply, but I need to use the time as well as the date. I have a networkdays code, that has the time, but it does not calculate correclty. I found the code I submitted above that works, but it does not include workdays.

Thanks,
David V.