I'm working on my family history and therefore often have to deal with dates that are before 1900. I have found the microsoft Agefunc macro that I can use to calculate age in years but I would like to have ages displayed as Years, Months, Days. I can do that already for dates after 01/01/1900 by using the Datedif function but I would like to combine the to functions so I can display the exact age for people born before 1900.
I'm a complete novice when it comes to formulae and macros but with a bit of help and perciverance, I usually get there in the end
The formula I use for post 1900 dates is =DATEDIF(Birth,Death,"Y")&" Y, "&DATEDIF(Birth,Death,"YM")&" M, "&DATEDIF(Birth,Death,"MD")&" D" which will return a value such as 64 y, 11 M, 4 D
what I would like to do (if it's possible) is to integrate the Agefunc into the above Datedif formula so I can get the same Year, Month, Day result for pre 1900 dates.
Is this possible?
The Agefunc macro is below and I have edited it to allow dates to be entered in UK format of DD, MM, YYYY (the month and day have to be entered as 2 digits or errors occur)
I know I'm asking a lot but, if anybody would like to take on a challenge and help me figure this out, I'd be very grateful
Redstick
I'm a complete novice when it comes to formulae and macros but with a bit of help and perciverance, I usually get there in the end
The formula I use for post 1900 dates is =DATEDIF(Birth,Death,"Y")&" Y, "&DATEDIF(Birth,Death,"YM")&" M, "&DATEDIF(Birth,Death,"MD")&" D" which will return a value such as 64 y, 11 M, 4 D
what I would like to do (if it's possible) is to integrate the Agefunc into the above Datedif formula so I can get the same Year, Month, Day result for pre 1900 dates.
Is this possible?
The Agefunc macro is below and I have edited it to allow dates to be entered in UK format of DD, MM, YYYY (the month and day have to be entered as 2 digits or errors occur)
VBA Code:
' This is the initial function. It takes in a start date and an end date.
Public Function AgeFunc(stdate As Variant, endate As Variant)
' Dim our variables.
Dim stvar As String
Dim stmon As String
Dim stday As String
Dim styr As String
Dim endvar As String
Dim endmon As String
Dim endday As String
Dim endyr As String
Dim stmonf As Integer
Dim stdayf As Integer
Dim styrf As Integer
Dim endmonf As Integer
Dim enddayf As Integer
Dim endyrf As Integer
Dim years As Integer
' This variable will be used to modify string length.
Dim fx As Integer
fx = 0
' Calls custom function sfunc which runs the Search worksheet function
' and returns the results.
' Searches for the first "/" sign in the start date.
stvar = sfunc("/", stdate)
' Parse the month and day from the start date.
stday = Left(stdate, sfunc("/", stdate) - 1)
stmon = Mid(stdate, stvar + 1, sfunc("/", stdate, sfunc("/", stdate) + 1) - stvar - 1)
' Check the length of the day and month strings and modify the string
' length variable.
If Len(stday) = 1 Then fx = fx + 1
If Len(stmon) = 2 Then fx = fx + 1
' Parse the year, using information from the string length variable.
styr = Right(stdate, Len(stdate) - (sfunc("/", stdate) + 1) - stvar + fx)
' Change the text values we obtained to integers for calculation
' purposes.
stmonf = CInt(stmon)
stdayf = CInt(stday)
styrf = CInt(styr)
' Check for valid date entries.
If stmonf < 1 Or stmonf > 12 Or stdayf < 1 Or stdayf > 31 Or styrf < 1 Then
AgeFunc = "Invalid Date"
Exit Function
End If
' Reset the string length variable.
fx = 0
' Parse the first "/" sign from the end date.
endvar = sfunc("/", endate)
' Parse the month and day from the end date.
endday = Left(endate, sfunc("/", endate) - 1)
endmon = Mid(endate, endvar + 1, sfunc("/", endate, sfunc("/", endate) + 1) - endvar - 1)
' Check the length of the day and month strings and modify the string
' length variable.
If Len(endday) = 1 Then fx = fx + 1
If Len(endmon) = 2 Then fx = fx + 1
' Parse the year, using information from the string length variable.
endyr = Right(endate, Len(endate) - (sfunc("/", endate) + 1) - endvar + fx)
' Change the text values we obtained to integers for calculation
' purposes.
endmonf = CInt(endmon)
enddayf = CInt(endday)
endyrf = CInt(endyr)
' Check for valid date entries.
If endmonf < 1 Or endmonf > 12 Or enddayf < 1 Or enddayf > 31 Or endyrf < 1 Then
AgeFunc = "Invalid Date"
Exit Function
End If
' Determine the initial number of years by subtracting the first and
' second year.
years = endyrf - styrf
' Look at the month and day values to make sure a full year has passed.
If stmonf > endmonf Then
years = years - 1
End If
If stmonf = endmonf And stdayf > enddayf Then
years = years - 1
End If
' Make sure that we are not returning a negative number and, if not,
' return the years.
If years < 0 Then
AgeFunc = "Invalid Date"
Else
AgeFunc = years
End If
End Function
' This is a second function that the first will call.
' It runs the Search worksheet function with arguments passed from AgeFunc.
' It is used so that the code is easier to read.
Public Function sfunc(x As Variant, y As Variant, Optional z As Variant)
sfunc = Application.WorksheetFunction.Search(x, y, z)
End FunctionI know I'm asking a lot but, if anybody would like to take on a challenge and help me figure this out, I'd be very grateful
Redstick
Last edited by a moderator:
