Help with macro for pre 1900 dates

Redstick

New Member
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)

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.
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 Function

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

Last edited by a moderator:

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the \$ sign).

Taul

Well-known Member
Hi,
I use a formula for my ancestry data for dates pre 1900, using the following headers in row 1:-
A1 = Name
B1 = DoB
C1 = Died
D1= Age

In cell D2 use this formula:-

Code:
=IF(ISBLANK(B2),"-",IF(ISBLANK(C2),"-",DATEDIF(IF(ISTEXT(B2),DATEVALUE(LEFT(B2,LEN(B2)-4)&RIGHT(B2,4)+1000),EDATE(B2,12000)),IF(ISTEXT(C2),DATEVALUE(LEFT(C2,LEN(C2)-4)&RIGHT(C2,4)+1000),EDATE(C2,12000)),"y")&" y "&DATEDIF(IF(ISTEXT(B2),DATEVALUE(LEFT(B2,LEN(B2)-4)&RIGHT(B2,4)+1000),EDATE(B2,12000)),IF(ISTEXT(C2),DATEVALUE(LEFT(C2,LEN(C2)-4)&RIGHT(C2,4)+1000),EDATE(C2,12000)),"ym") &" m " &DATEDIF(IF(ISTEXT(B2),DATEVALUE(LEFT(B2,LEN(B2)-4)&RIGHT(B2,4)+1000),EDATE(B2,12000)),IF(ISTEXT(C2),DATEVALUE(LEFT(C2,LEN(C2)-4)&RIGHT(C2,4)+1000),EDATE(C2,12000)),"md")&" d "))

It is adapted formula but the original formula came from this site and the output is in the form of
88 y 6 m 15 d

http://www.exceluser.com/formulas/earlydates.htm

There is an interesting article about the pitfalls of going back too far with the dates, it’s worth a read.
It also has a macro equivalent to download. I have not used the macro so I can’t say much about it.
Hope this helps

Paul.

Redstick

New Member
Hi Paul, Thanks for the quick reply
Thanks for the link, it is something I have already looked at and the macro is the one I gave in my first post.

I have tried your formula and of course, it works, however, I have a question, can it be modified to give a result if "C2" is blank, i.e. return an age if the person was still alive?
I know almost everybody born before 1900 will now be dead but if it can be modified it would mean the formula could be used for all age calculations e.g. Pre and Post 1900 and dead or alive.

Taul

Well-known Member
Hi,

Ok, this may be a bit clumsy but it appears to work

Code:
=IF(ISBLANK(B2),"-",IF(ISBLANK(C2),DATEDIF(IF(ISTEXT(B2),DATEVALUE(LEFT(B2,LEN(B2)-4)&RIGHT(B2,4)+1000),EDATE(B2,12000)),IF(ISTEXT(TODAY()),DATEVALUE(LEFT(TODAY(),LEN(TODAY())-4)&RIGHT(TODAY(),4)+1000),EDATE(TODAY(),12000)),"y")&" y "&DATEDIF(IF(ISTEXT(B2),DATEVALUE(LEFT(B2,LEN(B2)-4)&RIGHT(B2,4)+1000),EDATE(B2,12000)),IF(ISTEXT(TODAY()),DATEVALUE(LEFT(TODAY(),LEN(TODAY())-4)&RIGHT(TODAY(),4)+1000),EDATE(TODAY(),12000)),"ym")&" m "&DATEDIF(IF(ISTEXT(B2),DATEVALUE(LEFT(B2,LEN(B2)-4)&RIGHT(B2,4)+1000),EDATE(B2,12000)),IF(ISTEXT(TODAY()),DATEVALUE(LEFT(TODAY(),LEN(TODAY())-4)&RIGHT(TODAY(),4)+1000),EDATE(TODAY(),12000)),"md")&" d ",DATEDIF(IF(ISTEXT(B2),DATEVALUE(LEFT(B2,LEN(B2)-4)&RIGHT(B2,4)+1000),EDATE(B2,12000)),IF(ISTEXT(C2),DATEVALUE(LEFT(C2,LEN(C2)-4)&RIGHT(C2,4)+1000),EDATE(C2,12000)),"y")&" y "&DATEDIF(IF(ISTEXT(B2),DATEVALUE(LEFT(B2,LEN(B2)-4)&RIGHT(B2,4)+1000),EDATE(B2,12000)),IF(ISTEXT(C2),DATEVALUE(LEFT(C2,LEN(C2)-4)&RIGHT(C2,4)+1000),EDATE(C2,12000)),"ym")&" m "&DATEDIF(IF(ISTEXT(B2),DATEVALUE(LEFT(B2,LEN(B2)-4)&RIGHT(B2,4)+1000),EDATE(B2,12000)),IF(ISTEXT(C2),DATEVALUE(LEFT(C2,LEN(C2)-4)&RIGHT(C2,4)+1000),EDATE(C2,12000)),"md")&" d "))

edit - put the formula in cell D2

Redstick

New Member

Thanks for that.
I'm not sure what's wrong but, when I paste the formula into my sheet it is displayed at text, it does not work as a formula (all other formulas work normally)

Taul

Well-known Member
Hi,
I just replicated copy paste from the website and it works ok for me.
Are you sure you copied the whole formula, pasting as text may happen if the "=" sign is missing

Redstick

New Member

I've found the problem There was a space before the =
Works perfectly - Thank You.

Taul

Well-known Member
Good to know, I thought it would be something like that.

stangeba

New Member
Thanks!
Working for my relatives born pre-1900. I have everyone on a sheet and now have y / m / d.

fixit9660

New Member
Thanks!
Working for my relatives born pre-1900. I have everyone on a sheet and now have y / m / d.
AHA!! Just what I was looking for, and for the same reasons!! Thanks guys.

• Taul Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

1,152,821
Messages
5,772,464
Members
425,760
Latest member
paphon 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.    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

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