|
|
VBA > Function > Get Age
Age in years given a date of birth. Optionally, specify date to calculate age as of.
|
|
|
Age in years given a date of birth. Optionally, specify date to calculate age as of.
Initialize return value to 0 in case age can't be calculated Determine date to use for calculating age. Use current Date if passed date is missing or not valid
The birthday for the current year is determined using the Year of the as of date, then the Month and Day for the date of birth.
DateDiff using "yyyy" only calculates year difference If the as of date for calculating age is less than the birthday this year, then subtract 1 (True = -1)
DateDiff returns an Integer DateSerial constructs a date given a year, month, and day Get years between year for DOB and current year subtract 1 if birthday hasn't happened yet
I don't remember why DOB is optional (... slowly coming back ... perhaps it was to to test for IsMissing -- then get data another way) or why variant instead of date ... there was a reason ... Maybe they should be dates (another DSteele comment). And then there could be less error checking too.
'*************** Code Start ***************************************************** ' Purpose : Get age in whole years from a given birth date ' Author : crystal (strive4peace), modified per suggestion from Doug Steele ' Return : Integer ' License : below code ' Code List: www.MsAccessGurus.com/code.htm '-------------------------------------------------------------------------------' GetAge
'------------------------------------------------------------------------------- ' Public Function GetAge( _ Optional pDOB As Variant _ , Optional pDateAsOf As Variant _ ) As Integer ' ...180212 s4p, 181210 per suggestion from DSteele GetAge = 0 If IsMissing(pDOB) Then Exit Function If IsNull(pDOB) Then Exit Function If Not IsDate(pDOB) Then Exit Function Dim nDateAsOf As Date If IsMissing(pDateAsOf) _ Or pDateAsOf = 0 _ Or IsDate(pDateAsOf) <> True Then nDateAsOf = Date Else nDateAsOf = pDateAsOf End If GetAge = DateDiff("yyyy", pDOB, nDateAsOf) _ + (nDateAsOf < DateSerial(Year(nDateAsOf), Month(pDOB), Day(pDOB))) End Function ' ' LICENSE ' You may freely use and share this code ' provided this license notice and comment lines are not changed; ' code may be modified provided you clearly note your changes. ' You may not sell this code alone, or as part of a collection, ' without my handwritten permission. ' All ownership rights reserved. Use at your own risk. ' ~ crystal (strive4peace) www.MsAccessGurus.com '*************** Code End *******************************************************