Date Difference - options for Sec Min Hr Days Yr (1 Viewer)

[Rx_]

The web site in the comment was not active on the posting date.
This looked like the best universal function around.
For use in Access Query - one or both arguments are tested for Null and "" (empty string).

Option Compare Database
Public Function Diff2Dates(Interval As String, Date1 As Variant, Date2 As Variant, _
Optional ShowZero As Boolean = True) As Variant
      ' Set Variant = Null ----> on error value will return Null
      ' Full Credit To   [URL]http://www.pacificdb.com.au/Support/code_diff2dates.htm[/URL] - Upgraded Web site may have this code available later
      'Description:   This function calculates the number of years,
      '               months, days, hours, minutes and seconds between
      '               two dates, as elapsed time.
      '
      'Inputs:    Interval:   Intervals to be displayed (a string)
      '           Date1:      The lower date (see below)
      '           Date2:      The higher date (see below)
      '           ShowZero:   Boolean to select showing zero elements
      '
      'Outputs:   On error: Null
      '           On no error: Variant containing the number of years,
      '               months, days, hours, minutes & seconds between
      '               the two dates, depending on the display interval
      '               selected.
      '           If Date1 is greater than Date2, the result will
      '               be a negative value.
      '           The function compensates for the lack of any intervals
      '               not listed. For example, if Interval lists "m", but
      '               not "y", the function adds the value of the year
      '               component to the month component.
      '           If ShowZero is True, and an output element is zero, it
      '               is displayed. However, if ShowZero is False or
      '               omitted, no zero-value elements are displayed.
      '               For example, with ShowZero = False, Interval = "ym",
      '               elements = 0 & 1 respectively, the output string
      '               will be "1 month" - not "0 years 1 month".
      ' Example of uses in Immediate Window
                    'Print Diff2Dates("d", #12/31/2003#, #1/1/1999#)
                    '-1825 days  - If Negative is not needed, wrap formula above in an ABS()
                    
                    'Print Diff2Dates("d", #12/31/1999#, #1/1/2003#)
                    '1097 Days
                    
                    'Print Diff2Dates("y", #6/1/1998#, #6/26/2002#)
                    'Print Diff2Dates("y", #6/1/1998#, #6/26/2002#)
                    '4 years
                    'Print Diff2Dates("ymd", #6/1/1998#, #6/26/2002#)
                    '4 years 25 days
                    'Print Diff2Dates("ymd", #6/1/1998#, #6/26/2002#, True)
                    '4 years 0 months 25 days
                    'Print Diff2Dates("d", #6/1/1998#, #6/26/2002#)
                    '1486 Days
                    
                    'Print Diff2Dates("h", #1/25/2002 1:23:01 AM#, #1/26/2002 8:10:34 PM#)
                    '42 hours
                    'Print Diff2Dates("hns", #1/25/2002 1:23:01 AM#, #1/26/2002 8:10:34 PM#)
                    '42 hours 47 minutes 33 seconds
                    'Print Diff2Dates("dhns", #1/25/2002 1:23:01 AM#, #1/26/2002 8:10:34 PM#)
                    '1 day 18 hours 47 minutes 33 seconds
                    
                    'Print Diff2Dates("ymd", #12/31/1999#, #1/1/2000#)
                    '1 Day
                    'Print Diff2Dates("ymd", #1/1/2000#, #12/31/1999#)
                    '-1 day
                    'Print Diff2Dates("ymd", #1/1/2000#, #1/2/2000#)
                    '1 Day

      
      
      
      
      
10    On Error GoTo Err_Diff2Dates
         Dim booCalcYears As Boolean
         Dim booCalcMonths As Boolean
         Dim booCalcDays As Boolean
         Dim booCalcHours As Boolean
         Dim booCalcMinutes As Boolean
         Dim booCalcSeconds As Boolean
         Dim booSwapped As Boolean
         Dim dtTemp As Date
         Dim intCounter As Integer
         Dim lngDiffYears As Long
         Dim lngDiffMonths As Long
         Dim lngDiffDays As Long
         Dim lngDiffHours As Long
         Dim lngDiffMinutes As Long
         Dim lngDiffSeconds As Long
         Dim varTemp As Variant
         Const INTERVALS As String = "dmyhns"
15      Diff2Dates = Null                                   ' set to null on an error
      'Check that Interval contains only valid characters
20       Interval = LCase$(Interval)
30       For intCounter = 1 To Len(Interval)
40          If InStr(1, INTERVALS, Mid$(Interval, intCounter, 1)) = 0 Then
50             Exit Function
60          End If
70       Next intCounter
      'Check that valid dates have been entered
80       If IsNull(Date1) Then Exit Function
90       If IsNull(Date2) Then Exit Function
100      If Not (IsDate(Date1)) Then Exit Function
110      If Not (IsDate(Date2)) Then Exit Function
      'If necessary, swap the dates, to ensure that Date1 is lower than Date2
120      If Date1 > Date2 Then
130         dtTemp = Date1
140         Date1 = Date2
150         Date2 = dtTemp
160         booSwapped = True
170      End If
180      Diff2Dates = Null
190      varTemp = Null
      'What intervals are supplied
200      booCalcYears = (InStr(1, Interval, "y") > 0)
210      booCalcMonths = (InStr(1, Interval, "m") > 0)
220      booCalcDays = (InStr(1, Interval, "d") > 0)
230      booCalcHours = (InStr(1, Interval, "h") > 0)
240      booCalcMinutes = (InStr(1, Interval, "n") > 0)
250      booCalcSeconds = (InStr(1, Interval, "s") > 0)
      'Get the cumulative differences
260      If booCalcYears Then
270         lngDiffYears = Abs(DateDiff("yyyy", Date1, Date2)) - _
                    IIf(Format$(Date1, "mmddhhnnss") <= Format$(Date2, "mmddhhnnss"), 0, 1)
280         Date1 = DateAdd("yyyy", lngDiffYears, Date1)
290      End If
300      If booCalcMonths Then
310         lngDiffMonths = Abs(DateDiff("m", Date1, Date2)) - _
                    IIf(Format$(Date1, "ddhhnnss") <= Format$(Date2, "ddhhnnss"), 0, 1)
320         Date1 = DateAdd("m", lngDiffMonths, Date1)
330      End If
340      If booCalcDays Then
350         lngDiffDays = Abs(DateDiff("d", Date1, Date2)) - _
                    IIf(Format$(Date1, "hhnnss") <= Format$(Date2, "hhnnss"), 0, 1)
360         Date1 = DateAdd("d", lngDiffDays, Date1)
370      End If
380      If booCalcHours Then
390         lngDiffHours = Abs(DateDiff("h", Date1, Date2)) - _
                    IIf(Format$(Date1, "nnss") <= Format$(Date2, "nnss"), 0, 1)
400         Date1 = DateAdd("h", lngDiffHours, Date1)
410      End If
420      If booCalcMinutes Then
430         lngDiffMinutes = Abs(DateDiff("n", Date1, Date2)) - _
                    IIf(Format$(Date1, "ss") <= Format$(Date2, "ss"), 0, 1)
440         Date1 = DateAdd("n", lngDiffMinutes, Date1)
450      End If
460      If booCalcSeconds Then
470         lngDiffSeconds = Abs(DateDiff("s", Date1, Date2))
480         Date1 = DateAdd("s", lngDiffSeconds, Date1)
490      End If
500      If booCalcYears And (lngDiffYears > 0 Or ShowZero) Then
510         varTemp = lngDiffYears & IIf(lngDiffYears <> 1, " years", " year")
520      End If
530      If booCalcMonths And (lngDiffMonths > 0 Or ShowZero) Then
540         If booCalcMonths Then
550            varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _
                         lngDiffMonths & IIf(lngDiffMonths <> 1, " months", " month")
560         End If
570      End If
580      If booCalcDays And (lngDiffDays > 0 Or ShowZero) Then
590         If booCalcDays Then
600            varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _
                         lngDiffDays & IIf(lngDiffDays <> 1, " days", " day")
610         End If
620      End If
630      If booCalcHours And (lngDiffHours > 0 Or ShowZero) Then
640         If booCalcHours Then
650            varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _
                         lngDiffHours & IIf(lngDiffHours <> 1, " hours", " hour")
660         End If
670      End If
680      If booCalcMinutes And (lngDiffMinutes > 0 Or ShowZero) Then
690         If booCalcMinutes Then
700            varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _
                         lngDiffMinutes & IIf(lngDiffMinutes <> 1, " minutes", " minute")
710         End If
720      End If
730      If booCalcSeconds And (lngDiffSeconds > 0 Or ShowZero) Then
740         If booCalcSeconds Then
750            varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _
                         lngDiffSeconds & IIf(lngDiffSeconds <> 1, " seconds", " second")
760         End If
770      End If
780      If booSwapped Then
790         varTemp = "-" & varTemp
800      End If
810      Diff2Dates = Trim$(varTemp)
End_Diff2Dates:
820      Exit Function
Err_Diff2Dates:
830      Resume End_Diff2Dates
End Function