Date/Time Diff

Vergy39

Registered User.
Local time
Today, 13:11
Joined
Nov 6, 2009
Messages
109
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
 
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.

Code:
 '---------------------------------------------------------------------------------------
' 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
 
Here is a function to calculate workdays between 2 dates.
It does NOT deal with Public Holidays.
Hopefully this is helpful to you.

Code:
 '---------------------------------------------------------------------------------------
' 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.
 

Users who are viewing this thread

Back
Top Bottom