Function AgeCount5(varDOB As Variant, varDate As Variant) As String
' PURPOSE: Determines the difference between two dates in years,
' months and days.
'
' ARGUMENTS: (will accept either dates (e.g., #03/24/00#) or
' strings (e.g., "03/24/00")
' varDOB: The earlier of two dates.
' varDate: The later of two dates.
'
' RETURNS: A string as years.months.days, e.g., (17.6.21)
'
' CODED BY: raskew
'
' NOTES: To test: Type '? agecount5("03/04/83", "03/23/00")
' in the debug window. The function will
' return "17.0.19".
Dim dteDOB As Date
Dim dteDate As Date
Dim dteHold As Date
Dim intYears As Integer
Dim intMonths As Integer
Dim intDays As Integer
On Error GoTo Err_AgeCount5
If IsDate(varDOB) And IsDate(varDate) Then
dteDOB = DateValue(varDOB)
dteDate = DateValue(varDate)
'Reverse the dates if they were input backwards
If dteDOB > dteDate Then
dteHold = dteDOB
dteDOB = dteDate
dteDate = dteHold
End If
intYears = DateDiff("yyyy", dteDOB, dteDate) + (dteDate < _
DateSerial(Year(dteDate), Month(dteDOB), Day(dteDOB)))
dteDOB = DateAdd("yyyy", intYears, dteDOB)
intMonths = DateDiff("m", dteDOB, dteDate) + (Day(dteDOB) > Day(dteDate))
dteDOB = DateAdd("m", intMonths, dteDOB)
intDays = DateDiff("d", dteDOB, dteDate)
AgeCount5 = LTrim(Str(intYears)) & "." & LTrim(Str(intMonths)) & "." & LTrim(Str(Int(intDays)))
Else
MsgBox "Invalid date parameters -- please try again", vbOKOnly, "Check input dates!"
GoTo Exit_AgeCount5
End If
Exit_AgeCount5:
Exit Function
Err_AgeCount5:
Select Case Err.Number
Case 0
Resume Next
Case Else
MsgBox Err.Number & ": " & Err.Description
End Select
Resume Exit_AgeCount5
End Function