UDF tells age - now asking the same for deceased person

littlepete

Well-known Member
Joined
Mar 26, 2015
Messages
507
Office Version
  1. 365
Platform
  1. Windows
hello :)

The part in my formula talking about age has three parts:

1. " Pete is 60 years, 11 months and 27 days " (really!) ... = the case where the person is not dead: q6<>"" (born is not empty) and am6="" (deceased is empty) => age from q6 till today. (the udf avoids to show zero values too)...
2. " Pete has died. He was 84 years and 17 days " = the person has died: present the age when he died: from q6 till am6...
3. " he would have been 93 years and 17 days today " = the age that the deceased person would have today... age from q6 till today

column Q =date of birth; column AM = date of death.

i use an UDF for part 1 which works very well:
VBA Code:
Function Leeftijd(geboorte) ' geboorte=day of birth
maanden = DateDiff("m", geboorte, Date) + (Day(geboorte) > Day(Date))
d = CInt(Date - WorksheetFunction.EDate(geboorte, maanden))

If maanden Mod 12 > 1 And d > 1 Then
     Leeftijd = Int(maanden / 12) & " jaar, " & maanden Mod 12 & " maanden en " & d & " dagen "
ElseIf maanden Mod 12 > 1 And d = 1 Then
     Leeftijd = Int(maanden / 12) & " jaar, " & maanden Mod 12 & " maanden en " & d & " dag "
ElseIf maanden Mod 12 > 1 And d = 0 Then
     Leeftijd = Int(maanden / 12) & " jaar en " & maanden Mod 12 & " maanden "
ElseIf maanden Mod 12 = 1 And d > 1 Then
     Leeftijd = Int(maanden / 12) & " jaar, " & maanden Mod 12 & " maand en " & d & " dagen "
ElseIf maanden Mod 12 = 1 And d = 1 Then
     Leeftijd = Int(maanden / 12) & " jaar, " & maanden Mod 12 & " maand en " & d & " dag "
ElseIf maanden Mod 12 = 1 And d = 0 Then
     Leeftijd = Int(maanden / 12) & " jaar en " & maanden Mod 12 & " maand "
ElseIf maanden Mod 12 = 0 And d > 1 Then
     Leeftijd = Int(maanden / 12) & " jaar en " & d & " dagen "
ElseIf maanden Mod 12 = 0 And d = 1 Then
     Leeftijd = Int(maanden / 12) & " jaar en " & d & " dag "
ElseIf maanden Mod 12 = 0 And d = 0 Then
     Leeftijd = Int(maanden / 12) & " jaar "
End If

Delta = CInt(WorksheetFunction.EDate(geboorte, WorksheetFunction.MRound(maanden - (Day(geboorte) > Day(Date)), 12)) - Date)     'even afronden op een jaar
If Abs(Delta) < 20 Then

Select Case Delta
          Case 0: s = "VERJAART VANDAAG !"
          Case -1: s = "verjaarde gisteren"
          Case -2: s = "verjaarde eergisteren"
          Case 1: s = "verjaart morgen"
          Case 2: s = "verjaart overmorgen"
          Case 3: s = "verjaart binnen 3 dagen"
          Case -20 To -3: s = "verjaarde " & -Delta & " dagen geleden"
          Case 3 To 20: s = "verjaart binnen " & Delta & " dagen"
End Select
Leeftijd = Leeftijd & "oud (" & s & ")."
End If
End Function

i'm not finding the adjustment to construct part 2 and 3...
could someone copy this UDF and make the two other parts: besides leeftijd it could be named part 2 leeftijdovl and part 3 leeftijdvd ...

hoping for a solution :)
wishing you all a great Eastern !!!
thank you !
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
I am not familiar with Dutch but I have tried to take your UDF you provided and make the code easier to read. I added the second UDF you are looking for. The third UDF that you requested would basically be the first UDF. Try the following code out and let us know where you stand after that.

VBA Code:
Function Leeftijd(geboorte) ' geboorte=date of birth cell address ... Q6
'
    maanden = DateDiff("m", geboorte, Date) + (Day(geboorte) > Day(Date))       ' maanden = months
    d = CInt(Date - WorksheetFunction.EDate(geboorte, maanden))
'
    Select Case maanden Mod 12
        Case Is > 1
            Select Case d
                Case Is > 1: Leeftijd = Int(maanden / 12) & " jaar, " & maanden Mod 12 & " maanden en " & d & " dagen "
                Case Is = 1: Leeftijd = Int(maanden / 12) & " jaar, " & maanden Mod 12 & " maanden en " & d & " dag "
                Case Is = 0: Leeftijd = Int(maanden / 12) & " jaar en " & maanden Mod 12 & " maanden "
            End Select
        Case Is = 1
            Select Case d
                Case Is > 1: Leeftijd = Int(maanden / 12) & " jaar, " & maanden Mod 12 & " maand en " & d & " dagen "
                Case Is = 1: Leeftijd = Int(maanden / 12) & " jaar, " & maanden Mod 12 & " maand en " & d & " dag "
                Case Is = 0: Leeftijd = Int(maanden / 12) & " jaar en " & maanden Mod 12 & " maand "
            End Select
        Case Is = 0
            Select Case d
                Case Is > 1: Leeftijd = Int(maanden / 12) & " jaar en " & d & " dagen "
                Case Is = 1: Leeftijd = Int(maanden / 12) & " jaar en " & d & " dag "
                Case Is = 0: Leeftijd = Int(maanden / 12) & " jaar "
            End Select
    End Select
'
    Delta = CInt(WorksheetFunction.EDate(geboorte, WorksheetFunction.MRound(maanden - (Day(geboorte) > Day(Date)), 12)) - Date)     'even afronden op een jaar
'
    If Abs(Delta) < 20 Then
        Select Case Delta
            Case -20 To -3: s = "verjaarde " & -Delta & " dagen geleden"    ' This can't ever match -20 due to the Abs(Delta) < 20 line of code ;)
            Case -2: s = "verjaarde eergisteren"
            Case -1: s = "verjaarde gisteren"
            Case 0: s = "VERJAART VANDAAG !"
            Case 1: s = "verjaart morgen"
            Case 2: s = "verjaart overmorgen"
            Case 3: s = "verjaart binnen 3 dagen"
'
            Case 3 To 20: s = "verjaart binnen " & Delta & " dagen"     ' This can't ever match 3 because 3 has alreay been checked for ;)
        End Select
'
        Leeftijd = Leeftijd & "oud (" & s & ")."
    End If
End Function


Function leeftijdovl(geboorte, dood) ' geboorte=date of birth cell address ... Q6  dood = date of death cell address ... AM6
'
    maanden = DateDiff("m", geboorte, dood) + (Day(geboorte) > Day(dood))       ' maanden = months
    d = CInt(dood - WorksheetFunction.EDate(geboorte, maanden))
'
    Select Case maanden Mod 12
        Case Is > 1
            Select Case d
                Case Is > 1: leeftijdovl = Int(maanden / 12) & " jaar, " & maanden Mod 12 & " maanden en " & d & " dagen "
                Case Is = 1: leeftijdovl = Int(maanden / 12) & " jaar, " & maanden Mod 12 & " maanden en " & d & " dag "
                Case Is = 0: leeftijdovl = Int(maanden / 12) & " jaar en " & maanden Mod 12 & " maanden "
            End Select
        Case Is = 1
            Select Case d
                Case Is > 1: leeftijdovl = Int(maanden / 12) & " jaar, " & maanden Mod 12 & " maand en " & d & " dagen "
                Case Is = 1: leeftijdovl = Int(maanden / 12) & " jaar, " & maanden Mod 12 & " maand en " & d & " dag "
                Case Is = 0: leeftijdovl = Int(maanden / 12) & " jaar en " & maanden Mod 12 & " maand "
            End Select
        Case Is = 0
            Select Case d
                Case Is > 1: leeftijdovl = Int(maanden / 12) & " jaar en " & d & " dagen "
                Case Is = 1: leeftijdovl = Int(maanden / 12) & " jaar en " & d & " dag "
                Case Is = 0: leeftijdovl = Int(maanden / 12) & " jaar "
            End Select
    End Select
'
    Delta = CInt(WorksheetFunction.EDate(geboorte, WorksheetFunction.MRound(maanden - (Day(geboorte) > Day(dood)), 12)) - dood)     'even afronden op een jaar
'
    If Abs(Delta) < 20 Then
        Select Case Delta
            Case -20 To -3: s = "verjaarde " & -Delta & " dagen geleden"    ' This can't ever match -20 due to the Abs(Delta) < 20 line of code ;)
            Case -2: s = "verjaarde eergisteren"
            Case -1: s = "verjaarde gisteren"
            Case 0: s = "VERJAART VANDAAG !"
            Case 1: s = "verjaart morgen"
            Case 2: s = "verjaart overmorgen"
            Case 3: s = "verjaart binnen 3 dagen"
'
            Case 3 To 20: s = "verjaart binnen " & Delta & " dagen"     ' This can't ever match 3 because 3 has alreay been checked for ;)
        End Select
'
        leeftijdovl = leeftijdovl & "oud (" & s & ")."
    End If
End Function

I commented a couple of lines that are not fully executed the way you have them written, you may or may not want to address those issues.
 
Upvote 0
I am not familiar with Dutch but I have tried to take your UDF you provided and make the code easier to read. I added the second UDF you are looking for. The third UDF that you requested would basically be the first UDF. Try the following code out and let us know where you stand after that.

VBA Code:
Function Leeftijd(geboorte) ' geboorte=date of birth cell address ... Q6
'
    maanden = DateDiff("m", geboorte, Date) + (Day(geboorte) > Day(Date))       ' maanden = months
    d = CInt(Date - WorksheetFunction.EDate(geboorte, maanden))
'
    Select Case maanden Mod 12
        Case Is > 1
            Select Case d
                Case Is > 1: Leeftijd = Int(maanden / 12) & " jaar, " & maanden Mod 12 & " maanden en " & d & " dagen "
                Case Is = 1: Leeftijd = Int(maanden / 12) & " jaar, " & maanden Mod 12 & " maanden en " & d & " dag "
                Case Is = 0: Leeftijd = Int(maanden / 12) & " jaar en " & maanden Mod 12 & " maanden "
            End Select
        Case Is = 1
            Select Case d
                Case Is > 1: Leeftijd = Int(maanden / 12) & " jaar, " & maanden Mod 12 & " maand en " & d & " dagen "
                Case Is = 1: Leeftijd = Int(maanden / 12) & " jaar, " & maanden Mod 12 & " maand en " & d & " dag "
                Case Is = 0: Leeftijd = Int(maanden / 12) & " jaar en " & maanden Mod 12 & " maand "
            End Select
        Case Is = 0
            Select Case d
                Case Is > 1: Leeftijd = Int(maanden / 12) & " jaar en " & d & " dagen "
                Case Is = 1: Leeftijd = Int(maanden / 12) & " jaar en " & d & " dag "
                Case Is = 0: Leeftijd = Int(maanden / 12) & " jaar "
            End Select
    End Select
'
    Delta = CInt(WorksheetFunction.EDate(geboorte, WorksheetFunction.MRound(maanden - (Day(geboorte) > Day(Date)), 12)) - Date)     'even afronden op een jaar
'
    If Abs(Delta) < 20 Then
        Select Case Delta
            Case -20 To -3: s = "verjaarde " & -Delta & " dagen geleden"    ' This can't ever match -20 due to the Abs(Delta) < 20 line of code ;)
            Case -2: s = "verjaarde eergisteren"
            Case -1: s = "verjaarde gisteren"
            Case 0: s = "VERJAART VANDAAG !"
            Case 1: s = "verjaart morgen"
            Case 2: s = "verjaart overmorgen"
            Case 3: s = "verjaart binnen 3 dagen"
'
            Case 3 To 20: s = "verjaart binnen " & Delta & " dagen"     ' This can't ever match 3 because 3 has alreay been checked for ;)
        End Select
'
        Leeftijd = Leeftijd & "oud (" & s & ")."
    End If
End Function


Function leeftijdovl(geboorte, dood) ' geboorte=date of birth cell address ... Q6  dood = date of death cell address ... AM6
'
    maanden = DateDiff("m", geboorte, dood) + (Day(geboorte) > Day(dood))       ' maanden = months
    d = CInt(dood - WorksheetFunction.EDate(geboorte, maanden))
'
    Select Case maanden Mod 12
        Case Is > 1
            Select Case d
                Case Is > 1: leeftijdovl = Int(maanden / 12) & " jaar, " & maanden Mod 12 & " maanden en " & d & " dagen "
                Case Is = 1: leeftijdovl = Int(maanden / 12) & " jaar, " & maanden Mod 12 & " maanden en " & d & " dag "
                Case Is = 0: leeftijdovl = Int(maanden / 12) & " jaar en " & maanden Mod 12 & " maanden "
            End Select
        Case Is = 1
            Select Case d
                Case Is > 1: leeftijdovl = Int(maanden / 12) & " jaar, " & maanden Mod 12 & " maand en " & d & " dagen "
                Case Is = 1: leeftijdovl = Int(maanden / 12) & " jaar, " & maanden Mod 12 & " maand en " & d & " dag "
                Case Is = 0: leeftijdovl = Int(maanden / 12) & " jaar en " & maanden Mod 12 & " maand "
            End Select
        Case Is = 0
            Select Case d
                Case Is > 1: leeftijdovl = Int(maanden / 12) & " jaar en " & d & " dagen "
                Case Is = 1: leeftijdovl = Int(maanden / 12) & " jaar en " & d & " dag "
                Case Is = 0: leeftijdovl = Int(maanden / 12) & " jaar "
            End Select
    End Select
'
    Delta = CInt(WorksheetFunction.EDate(geboorte, WorksheetFunction.MRound(maanden - (Day(geboorte) > Day(dood)), 12)) - dood)     'even afronden op een jaar
'
    If Abs(Delta) < 20 Then
        Select Case Delta
            Case -20 To -3: s = "verjaarde " & -Delta & " dagen geleden"    ' This can't ever match -20 due to the Abs(Delta) < 20 line of code ;)
            Case -2: s = "verjaarde eergisteren"
            Case -1: s = "verjaarde gisteren"
            Case 0: s = "VERJAART VANDAAG !"
            Case 1: s = "verjaart morgen"
            Case 2: s = "verjaart overmorgen"
            Case 3: s = "verjaart binnen 3 dagen"
'
            Case 3 To 20: s = "verjaart binnen " & Delta & " dagen"     ' This can't ever match 3 because 3 has alreay been checked for ;)
        End Select
'
        leeftijdovl = leeftijdovl & "oud (" & s & ")."
    End If
End Function

I commented a couple of lines that are not fully executed the way you have them written, you may or may not want to address those issues.
hello :)

thank you for this perfectly working udf !!!

i'm very happy with the select and sub select... i didn't get to make it working :) !!!

i have inserted the udf in my formula it looks great !!!

i have now:

" pete is 33 years and 18 days old. "
or: " pete died on 18 december 2021. he was 71 year and 3 months old. "

could i ask for the third part that says : " he has died since 15 days " ? (if he died on april 1 2022)

have fun and thank you :) !!!
 
Upvote 0
Again, you will have to fix the dutch wording but the UDF is:

VBA Code:
Function leeftijdvd(dood) ' dood=date of death cell address ... AM6
'
    maanden = DateDiff("m", dood, Date) + (Day(dood) > Day(Date))       ' maanden = months
    d = CInt(Date - WorksheetFunction.EDate(dood, maanden))
'
    Select Case maanden Mod 12
        Case Is > 1
            Select Case d
                Case Is > 1: leeftijdvd = Int(maanden / 12) & " jaar, " & maanden Mod 12 & " maanden en " & d & " dagen "
                Case Is = 1: leeftijdvd = Int(maanden / 12) & " jaar, " & maanden Mod 12 & " maanden en " & d & " dag "
                Case Is = 0: leeftijdvd = Int(maanden / 12) & " jaar en " & maanden Mod 12 & " maanden "
            End Select
        Case Is = 1
            Select Case d
                Case Is > 1: leeftijdvd = Int(maanden / 12) & " jaar, " & maanden Mod 12 & " maand en " & d & " dagen "
                Case Is = 1: leeftijdvd = Int(maanden / 12) & " jaar, " & maanden Mod 12 & " maand en " & d & " dag "
                Case Is = 0: leeftijdvd = Int(maanden / 12) & " jaar en " & maanden Mod 12 & " maand "
            End Select
        Case Is = 0
            Select Case d
                Case Is > 1: leeftijdvd = Int(maanden / 12) & " jaar en " & d & " dagen "
                Case Is = 1: leeftijdvd = Int(maanden / 12) & " jaar en " & d & " dag "
                Case Is = 0: leeftijdvd = Int(maanden / 12) & " jaar "
            End Select
    End Select
'
    Delta = CInt(WorksheetFunction.EDate(dood, WorksheetFunction.MRound(maanden - (Day(dood) > Day(Date)), 12)) - Date)     'even afronden op een jaar
'
    If Abs(Delta) < 20 Then
        Select Case Delta
            Case -20 To -3: s = "verjaarde " & -Delta & " dagen geleden"    ' This can't ever match -20 due to the Abs(Delta) < 20 line of code ;)
            Case -2: s = "verjaarde eergisteren"
            Case -1: s = "verjaarde gisteren"
            Case 0: s = "VERJAART VANDAAG !"
            Case 1: s = "verjaart morgen"
            Case 2: s = "verjaart overmorgen"
            Case 3: s = "verjaart binnen 3 dagen"
'
            Case 3 To 20: s = "verjaart binnen " & Delta & " dagen"     ' This can't ever match 3 because 3 has alreay been checked for ;)
        End Select
'
        leeftijdvd = leeftijdvd & "oud (" & s & ")."
    End If
End Function
 
Upvote 0

Forum statistics

Threads
1,223,236
Messages
6,170,912
Members
452,366
Latest member
TePunaBloke

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top