Public Function AgeYMD(DOB As Date, today As Date, Optional WithMonths As Boolean = False, _
Optional WithDays As Boolean = False, Optional DisplayWithWords As Boolean = False) As Variant
'Author: © Copyright 2001 Pacific Database Pty Limited
' Graham R Seach gseach@pacificdb.com.au
' Phone: +61 2 9872 9594 Fax: +61 2 9872 9593
'
' You may freely use and distribute this code
' with any applications you may develop, on the
' condition that the copyright notice remains
' unchanged, and intact as part of the code. You
' may not sell or publish this code in any form
' without the express written permission of the
' copyright holder.
'
'Description: This function calculates a person's age,
' given their date of birth, and a second date.
'
'Inputs: DOB: The person's date of birth
' Today: The second date (ostensibly today)
' WithMonths: Boolean - If True, displays months
' DisplayWithWords: Boolean - If True, displays
' (ie: years / months)
'
'Outputs: On error: Null
' On no error: Variant containing person's age in
' years, months and days (if selected).
' If DisplayWithWords = False:
' Months and days, if selected, are shown
' to the right of the decimal point, but
' are the actual number of months and days,
' not a fraction of the year. For example,
' 44.11.03 = 44 years 11 months and 3 days.
' If DisplayWithWords = True:
' Output example: "44 years 11 months 3 days",
' except where months = 0, in which case, no
' months are shown.
On Error GoTo AgeYMD_ErrorHandler
Dim iYears As Integer
Dim iMonths As Integer
Dim iDays As Integer
Dim dTempDate As Date
'Check that the dates are valid
If Not (IsDate(DOB)) Or Not (IsDate(today)) Then
DoCmd.Beep
MsgBox "Invalid date.", vbOKOnly + vbInformation, "Invalid date"
GoTo AgeYMD_ErrorHandler
End If
'Check that DOB < Today
If DOB > today Then
DoCmd.Beep
MsgBox "Today must be greater than DOB.", _
vbOKOnly + vbInformation, "Invalid date position"
GoTo AgeYMD_ErrorHandler
End If
iYears = DateDiff("yyyy", DOB, today) - _
IIf(DateAdd("yyyy", DateDiff("yyyy", DOB, today), DOB) > today, 1, 0)
dTempDate = DateAdd("yyyy", iYears, DOB)
If WithMonths Then
iMonths = DateDiff("m", dTempDate, today) - _
IIf(DateAdd("m", iMonths, DateAdd("yyyy", iYears, DOB)) > today, 1, 0)
dTempDate = DateAdd("m", iMonths, dTempDate)
End If
If WithDays Then
iDays = today - dTempDate
End If
'Format the output
If DisplayWithWords Then
'Display the output in words
AgeYMD = IIf(iYears > 0, iYears & " year" & IIf(iYears <> 1, "s ", " "), "")
AgeYMD = AgeYMD & IIf(WithMonths, iMonths & " month" & IIf(iMonths <> 1, "s ", " "), "")
AgeYMD = Trim(AgeYMD & IIf(WithDays, iDays & " day" & IIf(iDays <> 1, "s", ""), ""))
Else
'Display the output in the format yy.mm.dd
AgeYMD = Trim(iYears & IIf(WithMonths, "." & Format(iMonths, "00"), "") _
& IIf(WithDays, "." & Format(iDays, "00"), ""))
End If
Exit_AgeYMD:
Exit Function
AgeYMD_ErrorHandler:
AgeYMD = Null
Resume Exit_AgeYMD
End Function
and with Left() you get two for the price of one.
