This VBA function uses the DateDiff() and DateSerial() functions to calculate an age in years. For example, if you would like to show the current age of an employee on a form or a report, you can call the function in the Control Source of a text box, and pass the employee birthday and the current date to the function like this:
=GetAge([EmployeeDOB], Date())
Public Function GetAge(Birthdate, CheckDate)
' This function returns the age in years between BirthDate and CheckDate.
' It passes back a Null if there is a problem.
'
' GetAge() Version 1.0.0
' Copyright © 2023 Extra Mile Data, www.extramiledata.com.
' For questions or issues, please contact [email protected].
' Use (at your own risk) and modify freely as long as proper credit is given.
'
On Error GoTo Err_Handler
Dim lngDiff As Long
' If an argument is missing, exit with a Null.
If IsNull(Birthdate) Or IsNull(CheckDate) Then
GetAge = Null
GoTo Exit_Proc
End If
' Get the difference in years.
lngDiff = DateDiff("yyyy", Birthdate, CheckDate)
' If the CheckDate day in year is before the BirthDate day, then remove a year.
If CheckDate < DateSerial(Year(CheckDate), Month(Birthdate), Day(Birthdate)) Then
lngDiff = lngDiff - 1
End If
GetAge = lngDiff
Exit_Proc:
On Error Resume Next
Exit Function
Err_Handler:
MsgBox Err.Number & " " & Err.Description, vbCritical, "GetAge()"
GetAge = Null
Resume Exit_Proc
End Function
Making Microsoft Access Work. Call (505) 369-1650.