Results 1 to 6 of 6
  1. #1
    Join Date
    May 2014
    Posts
    14

    Unanswered: Stop Age Growth when Date of Death inserted

    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.

  2. #2
    Join Date
    Mar 2009
    Posts
    5,442
    Provided Answers: 14
    Use this:
    Code:
    Public Function CalcAge(DOB As Date) As String
        
        Dim intYears As Integer, intMonths As Integer, intDays As Integer
        Dim dte as Date
    
        dte = Me.DateofDeath
        If IsNull(dte) Then dte = Date
        intMonths = DateDiff("m", DOB, dte)
        intDays = DateDiff("d", DateAdd("m", intMonths, DOB), dte)
        If intDays < 0 Then
            intMonths = intMonths - 1
            intDays = DateDiff("d", DateAdd("m", intMonths, DOB), dte)
        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
    Note: If DateOfDeath is not part of the Form data set (or is not accissible from the function), use a DLookUp() function to retrieve it. You couuld also retrieve it before calling the function, the declaration of which would become:
    Code:
    Public Function CalcAge(DOB As Date, dte As Date) As String
    Have a nice day!

  3. #3
    Join Date
    May 2014
    Posts
    14

    More Help Needed

    Out of my own ignorance where should I put the statement?
    Dim intYears As Integer, intMonths As Integer, intDays As Integer
    Dim dte as Date

    dte = Me.DateofDeath
    If IsNull(dte) Then dte = Date
    intMonths = DateDiff("m", DOB, dte)
    intDays = DateDiff("d", DateAdd("m", intMonths, DOB), dte)
    If intDays < 0 Then
    intMonths = intMonths - 1
    intDays = DateDiff("d", DateAdd("m", intMonths, DOB), dte)
    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

    Do I add it onto my current Before Update? If So where? I tried in my before update and it does not calculate at all I get is what you see in the screen shot
    My Control source for age is still set at =CalcAge([DOB]) does it still remain the same or does that change also? Thanks everyone for all your help
    Attached Thumbnails Attached Thumbnails DOD.jpg  

  4. #4
    Join Date
    Mar 2009
    Posts
    5,442
    Provided Answers: 14
    You modify the CalcAge() function:
    - If this function is in the form module, you can use:
    Code:
    dte = Me.DateofDeath
    - If the function is in another module, you can either use a DLookUp() function to retrieve the DateOfDeath value, or you can modify the declaration of the function and pass the DateOfDeath value along with the DOB:
    Code:
    Public Function CalcAge(DOB As Date, Dte as Date) As String
        
        Dim intYears As Integer, intMonths As Integer, intDays As Integer
        If IsNull(dte) Then dte = Date
    Have a nice day!

  5. #5
    Join Date
    May 2014
    Posts
    14

    Hello

    I think I understand what your saying but not sure how to implement it. I copied the following code into my Before Update


    Private Sub Age_BeforeUpdate(Cancel As Integer)
    Dim intYears As Integer, intMonths As Integer, intDays As Integer
    Dim dte As Date
    dte = Me.DateOfDeath
    If IsNull(dte) Then dte = Date
    intMonths = DateDiff("m", DOB, dte)
    intDays = DateDiff("d", DateAdd("m", intMonths, DOB), dte)
    If intDays < 0 Then
    intMonths = intMonths - 1
    intDays = DateDiff("d", DateAdd("m", intMonths, DOB), dte)
    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 than Added dte = Me.DateofDeath as my control Source for Age and it is not working.

    I really do appreciate all the help from everyone

  6. #6
    Join Date
    Mar 2009
    Posts
    5,442
    Provided Answers: 14
    From the very beginning there was a problem with the code you posted:
    Code:
    Private Sub Age_BeforeUpdate(Cancel As Integer)
    Public Function CalcAge(DOB As Date) As String
    Dim intYears As Integer, intMonths As...
    You cannot include a function into a sub procedure in VBA.

    I asserted that, for a reason or another, you created a dedicated CalAge() function (possibly for being able to use it from several places in your project), and that the declaration line for the sub procedure Age_BeforeUpdate() was an error you made while posting the code.

    Now it seems that the procedure Age_BeforeUpdate() is actually in use, presumably in the form module and presumably calling the CalAge function(). All this is very confusing and to be able to clarify my understanding of how you code is really organized, I would need to see a copy of both procedures (not mixed toghether) as well as to know in which module is the CalAge() function located and how it is used.
    Have a nice day!

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •