Stopping Age from Growing When Date of Death Inserted

[wes9659]

Here is another perplexing questions for the Access Guru Gods . I have created a Date of birth field that is populated when a date of birth is entered it triggers this Before Update event:

Private Sub Age_BeforeUpdate(Cancel As Integer)
Public Function CalcAge(DOB As Date) As String
Dim intYears As Integer, intMonths As Integer, intDays As Integer
intMonths = DateDiff("m", DOB, Date)
intDays = DateDiff("d", DateAdd("m", intMonths, DOB), Date)
If intDays < 0 Then
intMonths = intMonths - 1
intDays = DateDiff("d", DateAdd("m", intMonths, DOB), Date)
End If
intYears = intMonths \ 12
intMonths = intMonths Mod 12
CalcAge = intYears & " year" & IIf(intYears = 1, "", "s") _
& ", " & intMonths & " month" & IIf(intMonths = 1, "", "s") _
& " and " & intDays & " day" & IIf(intDays = 1, "", "s")
End Function



I have Age field Control Source set to =CalcAge([DOB])

It works perfect.

Now my question, I want the field to continue to increase as time goes by which it does now perfectly. However, I have another field which is entitled DateofDeath. Once I enter a date in that field I want the Age field mentioned above to stop growing as time goes by and lock in that date. So when I look back on record I can say John Smith was 49 years, 10 months and 21 days when he died. Thanks everyone for all the help. Is it just me or is this program addicting.

[fredz]

I use a slightly different function for age calculation.
I think it is simpler and more intuitive.

Public Function CalcAge(fDOB As Date) As String
CalcAge = Year(Date) - Year(fDOB)
' subtract 1 year if haven't had birthday yet this year
If Format(Date, "mmdd") < Format(fDOB, "mmdd") Then
CalcAge = CalcAge - 1
Endif
End Function


You might then adjust that function to allow for dead persons
by adding Date Of Death as a 2nd parameter. I assume that
Date Of Death is Null when the person is still alive.

Public Function CalcAge(fDOB As Date, fDOD As Variant) As String
CalcAge = Year(Nz(fDOD, Date)) - Year(fDOB)
If Format(Nz(fDOD, Date), "mmdd") < Format(fDOB, "mmdd") Then
CalcAge = CalcAge - 1
End If
End Function

Fred

[amrut]

intMonths = DateDiff("m", DOB, Date)
intDays = DateDiff("d", DateAdd("m", intMonths, DOB), Date)

Instead of Date, test if the DateofDeath has a valid value.
Something like -
Dim CalculationDate as Date
If IsDate(DateofDeath) then
CalculationDate =DateofDeath
Else
CalculationDate =Date
Endif
Then , Person's age =CalcAge(CalculationDate)

[wes9659]

Out of my own ignorance where should I put the statement?
Dim CalculationDate as Date
If IsDate(DateofDeath) then
CalculationDate =DateofDeath
Else
CalculationDate =Date
Endif
Then , Person's age =CalcAge(CalculationDate)

Do I add it onto my current Before Update? If So where?
Private Sub Age_BeforeUpdate(Cancel As Integer)
Public Function CalcAge(DOB As Date) As String
Dim intYears As Integer, intMonths As Integer, intDays As Integer
intMonths = DateDiff("m", DOB, Date)
intDays = DateDiff("d", DateAdd("m", intMonths, DOB), Date)
If intDays < 0 Then
intMonths = intMonths - 1
intDays = DateDiff("d", DateAdd("m", intMonths, DOB), Date)
End If
intYears = intMonths \ 12
intMonths = intMonths Mod 12
CalcAge = intYears & " year" & IIf(intYears = 1, "", "s") _
& ", " & intMonths & " month" & IIf(intMonths = 1, "", "s") _
& " and " & intDays & " day" & IIf(intDays = 1, "", "s")
End Function

Also does my Control source of =CalcAge([DOB]) remain the same or does that change also? Thanks everyone for all your help

[June7]

This code should be a public function in a public module so it can be called from anywhere when needed, not in an event procedure.

Cannot have procedure declaration lines one after another. Every procedure declaration must having a matching End line and no other procedure declaration can be in between them, that includes functions.

ControlSource expression remains unchanged unless you change the declared function name or arguments.

[amrut]

You can modify the code I gave into an expression and use as a controlsource. You can use the same function to calculate age but it has to be in the form's module as you need to validate the DateofDeath.

Function CalcAge(DOB As Date) As String
'
'
End Function

For testing purpose, add a textbox to your form say txtDate. Set it's controlsource to IIf(IsDate(DateOfDeath),DateOfDeath,Date). Once this is displaying the correct date, set the age controls source to show age as =CalcAge([txtDate]). If it is working correctly, change the controlsource to =CalcAge(IIf(IsDate(DateOfDeath),DateOfDeath,Date) ).
If you need to call this function from other forms/reports, you have to put it into a module with a slight modification. The function will need two dates to calculate age.

Public Function CalcAge(DOB As Date, FinalDate as Date) As String
' 
'
intMonths = DateDiff("m", DOB, FinalDate)
intDays = DateDiff("d", DateAdd("m", intMonths, DOB), FinalDate)
If intDays < 0 Then
intMonths = intMonths - 1
intDays = DateDiff("d", DateAdd("m", intMonths, DOB), FinalDate)
End If
'
'

End Function

Then the expression have to be changed to have both the date fields.
Post back if you have any difficulties. Further, do follow June's advice

[June7]

Amrut is right, and I should have noted in my earlier post, placing the code in a general module would require changing it to pass the death date by another argument. However, I think amrut forgot to include DOB in the expression to call the function.

An alternative syntax for calling the modified function could be:

CalcAge(DOB, Nz(DateOfDeath, Date))

[amrut]

Good point, to use the Nz function

amrut forgot to include DOB in the expression to call the function.

Left some work for OP

Then the expression have to be changed to have both the date fields.

[June7]

VBA function might not be required.

Round(DateDiff("m", [DOB], Nz(DateOfDeath, Date)) / 12, 2)

How precise do you want the age calculation?

[wes9659]

Here is how it was solved

1) Created this Public Module:

Public Function FindAge(DOB As Date, CalcDate As Date) As String
Dim intYears As Integer, intMonths As Integer, intDays As Integer
intMonths = DateDiff("m", DOB, CalcDate)
intDays = DateDiff("d", DateAdd("m", intMonths, DOB), CalcDate)
If intDays < 0 Then
intMonths = intMonths - 1
intDays = DateDiff("d", DateAdd("m", intMonths, DOB), CalcDate)
End If
intYears = intMonths \ 12
intMonths = intMonths Mod 12

FindAge = intYears & " year" & IIf(intYears = 1, "", "s") _
& ", " & intMonths & " month" & IIf(intMonths = 1, "", "s") _
& " and " & intDays & " day" & IIf(intDays = 1, "", "s")
End Function

2.) Created a blank Text Box
3.) Named it txtDate
4.) Set the Control Source of txtDate to: =IIf(IsDate([DateOfDeath]),[DateOfDeath],Date())
5.) Set Control Source of Age field to the following:
=FindAge([Forms]![Funeral Record]![NavigationSubform].[Form]![DOB],[Forms]![Funeral Record]![NavigationSubform].[Form]![txtDate])
6.) Made newly created field txtDate a hidden field
Now when DOB (date of birth is added it continues to stay current, until Date of Death is enter into the DateOfDeath field. At that point age locks in and stops increasing.

I want to thank everyone for all their help with this issue especially Amrut, June7 and FredZ. I applaud each of you for reaching out and helping others.