asked on

# Arriving at an age in years based on birthday and a specified day.

Trying to calculate the age of a person (in years) on a particular date.

I have the following fields in the table

DOB = "Date of Birth", date field

EOGM = "End of Game Year"

So if the end of the game year is 8/31/2022, and someone was born 9/2/1972, then they shouldn't be considered 50 years old.   To be 50 or older, they should have been born on 8/31/1972 or earlier.   Right?

I've been trying to use DateDiff, combined with DateSerial to get an age in years, but no luck.  I've also tried Int()

Feel like I'm close....   just can't get what I think is the right answer.

Martin Liss

This "Age" function I found on a Microsoft site (and modified to include your EOGM rather than Now) says your person is 50.

``````Function Age(varBirthDate As Variant) As Integer
Dim varAge As Variant

If IsNull(varBirthDate) Then Age = 0: Exit Function

varAge = DateDiff("yyyy", varBirthDate, CDate("8/31/2022"))
If Date < DateSerial(Year(Now), Month(varBirthDate), _
Day(varBirthDate)) Then
varAge = varAge - 1
End If
Age = CInt(varAge)
End Function

Sub test()
MsgBox Age("9/2/1972")
End Sub``````
I corrected my change. It now gives 49.

``````Function Age(varBirthDate As Variant) As Integer
Dim varAge As Variant

If IsNull(varBirthDate) Then
Age = 0
Exit Function
End If

varAge = DateDiff("yyyy", varBirthDate, CDate("8/31/2022"))
If CDate("8/31/2022") < DateSerial(Year(CDate("8/31/2022")), Month(varBirthDate), Day(varBirthDate)) Then
varAge = varAge - 1
End If
Age = CInt(varAge)

End Function``````
Hmmmm,

If the fonction recieve a null value, it should return null since it can't perform its job (computing an age from null make no sens).

ASKER

I feel like Martin's AGE function will work (don't think the NULL possibility will be a problem)

Probably a silly question.....  but do I put this AGE FUNCTION in a "global" module, then I would be able to refer to it in an update sql statement (that is run from a button on a form)?

I need a process to run thru the CONTACTS table and UPDATE the AGE field based on results.

Originally I had a YES/NO field for [50AndOver], but after seeing what was most likely possible with DateDiff, i created a new field called AGE, and will just select the "50 and over" folks from that.
THanks for your help
If you change the function's declaration statement to the following it will be available everywhere in your workbook.
Public Function Age(varBirthDate As Variant) As Integer
I changed the function to include a second parameter for the EOGM date which I assume is variable.
``````Public Function Age(dteBirthDate As Date, dteEOGM As Date) As Integer
Dim intAge As Integer

If IsNull(dteBirthDate) Then
Age = 0
Exit Function
End If

intAge = DateDiff("yyyy", dteBirthDate, dteEOGM)
If dteEOGM < DateSerial(Year(dteEOGM), Month(dteBirthDate), Day(dteBirthDate)) Then
intAge = intAge - 1
End If
Age = intAge

End Function
Sub HowToUse()
MsgBox Age("9/2/1972", "8/31/2022")
End Sub``````
If you want to call the function from a query, it must match the following requirement:
- Must be in a standard module.
- Must be public.
- Arguments (if any) must be variant (ehence they must be tested against Null value).
- Return data type must be variant, to supportNull value.
- Must apply database math.

Database math follow the rules below:
Any concatenation performed with a Null value yeld the value itself converted into string if necessary (concatenation only apply to strings), the convertion can be implicit:
``````"my string" & Null = "my string"
345 & Null = "345"``````
Any operation performed with a Null operand yeld Null:
``````1248 * Null = Null
256 And Null = Null``````
Any comparition performed against a Null value is False:
``````If(5 = Null)       '// the test is False
If(Null = Null)    '// The test is false``````

If you don't intend to call the function from a query, arguments can be strong data type (heavilly recommened), in such case, there is no need to test for null arguments since strong data types do not support Null values.
So, I allow myself to fix Martin's 2nd code:
``````Public Function Age(dteBirthDate As Date, dteEOGM As Date) As Integer
Dim intAge As Integer
'// arguments are Date type, wich is strong.
'// Testing against null is a no sens.
intAge = DateDiff("yyyy", dteBirthDate, dteEOGM)
If dteEOGM < DateSerial(Year(dteEOGM), Month(dteBirthDate), Day(dteBirthDate)) Then
intAge = intAge - 1
End If
Age = intAge
End Function``````

ASKER

So, here is what I'm trying.
I changed a couple of names to make better sense (for project)....
Getting an error when it tries to get the contact date of birth (DOB).

dteEORY... (instead of EOGY  This parameter will never be blank.
``````Private Sub Cmd4_Click()
Dim dteDOB As Date
Dim dteEORY As Date
Dim intAge As Integer
dteEORY = DLookup("FieldValue", "tblParameters", "[FieldName] = 'CurrentYearEnds'")
Dim MyDB As DAO.Database
Dim MyRst As DAO.Recordset
Set MyRst = CurrentDb.OpenRecordset("tblContacts")

MyRst.MoveFirst
Do Until MyRst.EOF
MyRst.Edit
dteDOB = MyRst![DOB]
If IsNull(dteDOB) Then
MyRst![Age] = 0
MyRst.Update
MyRst.MoveNext
GoTo NoDOB
End If

intAge = DateDiff("yyyy", dteDOB, dteEORY)
If dteEORY < DateSerial(Year(dteEORY), Month(dteDOB), Day(dteDOB)) Then
intAge = intAge - 1
End If
MyRst![AgeAtEOY] = intAge
NoDOB:
MyRst.MoveNext

Loop

MyRst.Close
Set MyRst = Nothing``````

ASKER

Just tested with fewer records, and it did not error out if the DOB isn't blank.

But it also did not update the Age At End Of Year field (AgeAtEOY)

So what do I need on the line to skip around a NULL birthday?
and what am I missing to update the field for their age?

Thanks so much
ASKER CERTIFIED SOLUTION
Martin Liss

membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.

ASKER

Good catch, I had left the MyRst.Update line off after setting the AGE.
CHecking for If Not IsNull, also seemed to do the trick instead of the way I was trying.

Thanks for taking time to deal with my less than perfect method.   I realize it isn't textbook, but we're not transplanting kidneys or anything.  :o)
You’re welcome and I’m glad I was able to help. Thank you for the testimonial.

If you expand the “Full Biography" section of my profile you’ll find links to some articles I’ve written that may interest you.

Marty - Microsoft MVP 2009 to 2017
Experts Exchange Most Valuable Expert (MVE) 2015, 2017
Experts Exchange Distinguished Expert in Excel 2018
Experts Exchange Top Expert Visual Basic Classic 2012 to 2020
Experts Exchange Top Expert VBA 2018 to 2020