Rx_
Nothing In Moderation
- Local time
- Yesterday, 23:56
- Joined
- Oct 22, 2009
- Messages
- 2,803
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).
This looked like the best universal function around.
For use in Access Query - one or both arguments are tested for Null and "" (empty string).
Code:
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