Difference between 2 dates

[Sarah]

I need a macro that will calculate the difference between a persons
date of birth and the current date, but in YEARS and DAYS only.

Any help would be greatly appreciated.

Thanks

 

[Charles Kenyon]

This is trickier than you might think. All the work has been done, though.
See
http://www.wopr.com/cgi-bin/w3t/showflat.pl?Cat=&Board=wrd&Number=249902.

More: <URL: http://addbalance.com/word/datefields1.htm> for information on
the different kinds of datefields and how to format them.

 

[Peter Hewett]

Hi Sarah

You can use this code to do what you want:

Public Sub DOBDiff()
Dim dateDOB As Date
Dim dateToday As Date
Dim lngYears As Long
Dim lngDays As Long

dateDOB = "11/11/61"
dateToday = Date

lngYears = DateDiff("yyyy", dateDOB, dateToday)
If DateSerial(Year(dateDOB) + lngYears, Month(dateDOB), Day(dateDOB)) > _
DateSerial(Year(dateToday), Month(dateToday), Day(dateToday)) Then
lngYears = lngYears - 1
lngDays = DateDiff("d", DateSerial(Year(dateToday) - 1, Month(dateDOB), _
Day(dateDOB)), dateToday)
Else
lngDays = DateDiff("d", DateSerial(Year(dateToday), Month(dateDOB), _
Day(dateDOB)), dateToday)
End If
Debug.Print "Years: " & lngYears, "Days: " & lngDays
End Sub

HTH + Cheers - Peter


(e-mail address removed) (Sarah), said:

 

[Peter Hewett]

Hi Charles Kenyon

No disrespect to 'pod, but at least I can understand the code I write (well sometimes!)
but those nested fields coming out the wazoo - oh boy!

Cheers - Peter

This is trickier than you might think. All the work has been done, though.
See
http://www.wopr.com/cgi-bin/w3t/showflat.pl?Cat=&Board=wrd&Number=249902.

More: <URL: http://addbalance.com/word/datefields1.htm> for information on
the different kinds of datefields and how to format them.

HTH + Cheers - Peter

 

[Peter Hewett]

Hi Peter Hewett

Just read my previous post, sorry the code I posted was a tad messy, this is better:

Public Sub DOBDiff()
Dim dateDOB As Date
Dim dateToday As Date
Dim lngYears As Long
Dim lngDays As Long

dateDOB = "11/11/61"
dateToday = Date

' If it's before this years birthday we need to correct the year
lngYears = DateDiff("yyyy", dateDOB, dateToday)
If DateSerial(Year(dateDOB) + lngYears, Month(dateDOB), Day(dateDOB)) > _
dateToday Then

' Correct for extra calculated year
lngYears = lngYears - 1
lngDays = DateDiff("d", DateSerial(Year(dateToday) - 1, _
Month(dateDOB), Day(dateDOB)), dateToday)
Else

' Just do the days since we've already done the years
lngDays = DateDiff("d", DateSerial(Year(dateToday), _
Month(dateDOB), Day(dateDOB)), dateToday)
End If
Debug.Print "Years: " & lngYears, "Days: " & lngDays
End Sub

Cheers - Peter

Hi Sarah

You can use this code to do what you want:

Public Sub DOBDiff()
Dim dateDOB As Date
Dim dateToday As Date
Dim lngYears As Long
Dim lngDays As Long

dateDOB = "11/11/61"
dateToday = Date

lngYears = DateDiff("yyyy", dateDOB, dateToday)
If DateSerial(Year(dateDOB) + lngYears, Month(dateDOB), Day(dateDOB)) > _
DateSerial(Year(dateToday), Month(dateToday), Day(dateToday)) Then
lngYears = lngYears - 1
lngDays = DateDiff("d", DateSerial(Year(dateToday) - 1, Month(dateDOB), _
Day(dateDOB)), dateToday)
Else
lngDays = DateDiff("d", DateSerial(Year(dateToday), Month(dateDOB), _
Day(dateDOB)), dateToday)
End If
Debug.Print "Years: " & lngYears, "Days: " & lngDays
End Sub

HTH + Cheers - Peter


(e-mail address removed) (Sarah), said:

HTH + Cheers - Peter

 

[Charles Kenyon]

The best I've done with an attempt at documentation was to color code the
levels of nesting. It is a bear.

 

[Sarah]

Thank you Peter.
I've added the code to the rest of my procedure and it seems to be working !