Age Calculation

[Janna]

I'm would like to calculate the age a person was from a given date--not
today's date. My form name is frmEntry which has two fields called
DateScreen and DOB. I would like the following functions to calculate what
age the person was at the time of DateScreen and return the value in a third
field on my form called Age (which contains the following code =Age([DOB]) &
" yr(s) " & AgeMonths([DOB]) & " mos")
Any help is GREATLY appreciated!!--When I try the following code, it is one
year off.


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


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

varAge = DateDiff("yyyy", varBirthDate, Form_frmEntry.DateScreen)
If Date < DateSerial(Year(Form_frmEntry.DateScreen), Month(varBirthDate),
Day(varBirthDate)) Then
varAge = varAge - 1
End If
Age = CInt(varAge)
End Function

Function AgeMonths(ByVal StartDate As String) As Integer

Dim tAge As Double
tAge = (DateDiff("m", StartDate, Form_frmEntry.DateScreen))
If (DatePart("d", StartDate) > DatePart("d", Form_frmEntry.DateScreen))
Then
tAge = tAge - 1
End If
If tAge < 0 Then
tAge = tAge + 1
End If

AgeMonths = CInt(tAge Mod 12)

End Function

 

[jl5000]

Try these: for the dteToDate send your form's date as a parameter, that way
you can use thse functions from any form

Function Age_Years(ByVal dteBirthDate, _
ByVal dteToDate) As Integer
Dim intYears As Integer
Dim dteDate As Date

If dteToDate <= dteBirthDate Then
intYears = 0
Exit Function
End If

dteDate = CDate("" & Month(dteBirthDate) & _
"/" & Day(dteBirthDate) & _
"/" & Year(dteToDate))

intYears = Year(dteDate) - Year(dteBirthDate)

If dteDate > dteToDate Then: intYears = intYears - 1

Age_Years = intYears

End Function

Function Age_Months(ByVal dteBirthDate, _
ByVal dteToDate) As Integer
Dim intMonths As Integer
Dim dteDate As Date

If dteToDate <= dteBirthDate Then
intMonths = 0
Exit Function
End If

dteDate = CDate("" & Month(dteToDate) & _
"/" & Day(dteBirthDate) & _
"/" & Year(dteToDate))

If Month(dteDate) > Month(dteBirthDate) Then
intMonths = Month(dteDate) - Month(dteBirthDate)
Else
intMonths = 12 - Month(dteBirthDate) + Month(dteDate)
End If

If dteDate > dteToDate Then: intMonths = intMonths - 1

If intMonths = 12 Then: intMonths = 0

Age_Months = intMonths

End Function

 

[SteveS]

I'm would like to calculate the age a person was from a given date--not
today's date. My form name is frmEntry which has two fields called
DateScreen and DOB. I would like the following functions to calculate what
age the person was at the time of DateScreen and return the value in a third
field on my form called Age (which contains the following code =Age([DOB]) &
" yr(s) " & AgeMonths([DOB]) & " mos")
Any help is GREATLY appreciated!!--When I try the following code, it is one
year off.


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


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

varAge = DateDiff("yyyy", varBirthDate, Form_frmEntry.DateScreen)
If Date < DateSerial(Year(Form_frmEntry.DateScreen), Month(varBirthDate),
Day(varBirthDate)) Then
varAge = varAge - 1
End If
Age = CInt(varAge)
End Function

Function AgeMonths(ByVal StartDate As String) As Integer

Dim tAge As Double
tAge = (DateDiff("m", StartDate, Form_frmEntry.DateScreen))
If (DatePart("d", StartDate) > DatePart("d", Form_frmEntry.DateScreen))
Then
tAge = tAge - 1
End If
If tAge < 0 Then
tAge = tAge + 1
End If

AgeMonths = CInt(tAge Mod 12)

End Function

Here is your code modified slightly... I couldn't get it to work as written.

One problem was (if I read your post correctly) was that a control (the third
text box) and the year function had the same name "age". I changed the name of
the function to "AgeYears".

You were trying to get the value of the second date by using
"Form_frmEntry.DateScreen". You have to either pass the value, like you did the
DOB, or use "Forms!FormName.[NameOfControl]" where "FormName" is the name of
the form and "[ControlName]" is the name of the control you want to get the
value from.

In the year function you were comparing "DATE" to the date serial, instead of
"DateScreen":

If Date < DateSerial(Year(Form_frmEntry.DateScreen), Month(varBirthDate),
Day(varBirthDate)) Then

Here is you modified code:

'**** begin code *******
Function ageYears(varBirthDate As Date, varScreenDate As Date) As Integer
Dim varAge As Integer

If IsNull(varBirthDate) Or IsNull(varScreenDate) Or varScreenDate <
varBirthDate Then
ageYears = 0
Exit Function
End If

ageYears = DateDiff("yyyy", varBirthDate, varScreenDate)

If varScreenDate < DateSerial(Year(varScreenDate), Month(varBirthDate),
Day(varBirthDate)) Then
ageYears = ageYears - 1
End If
End Function

Function AgeMonths(StartDate As Date, varScreenDate As Date) As Integer

Dim tAge As Integer
tAge = (DateDiff("m", StartDate, varScreenDate))
If (DatePart("d", StartDate) > DatePart("d", varScreenDate)) Then
tAge = tAge - 1
End If
If tAge < 0 Then
tAge = tAge + 1
End If

AgeMonths = CInt(tAge Mod 12)

End Function

'**** end code ***


To calc the age, third field on the form called Age would contain the following :

=AgeYears([DOB],[DateScreen]) & " yr(s) " & AgeMonths([DOB][DateScreen]) & " mos"



HTH

 

[Graham R Seach]

Janna,

You could try this:
http://www.pacificdb.com.au/MVP/Code/Age2.htm

Regards,
Graham R Seach
Microsoft Access MVP
Sydney, Australia

Microsoft Access 2003 VBA Programmer's Reference
http://www.wiley.com/WileyCDA/WileyTitle/productCd-0764559036.html