Finding the Next Anniversary
Often, when working with dates, you have stored away a birthday or a wedding date and need to find out the next occurrence of the anniversary of that date. The function in this section, dhNextAnniversary (Listing 2.6), will do that chore for you. Given a date, it finds the next anniversary of that date, taking into account the current date.
Listing 2.6: Find the Next Anniversary of a Date
Function dhNextAnniversary(dtmDate As Date) As Date
' Given a date, find the next anniversary of that date.
Dim dtmThisYear As Date
' What's the corresponding date in the current year?
dtmThisYear = DateSerial(Year(Now), Month(dtmDate), _
Day(dtmDate))
' If the anniversary has already occurred, then add 1
' to the year.
If dtmThisYear < Date Then
dtmThisYear = DateAdd("yyyy", 1, dtmThisYear)
End If
dhNextAnniversary = dtmThisYear
End Function
This one's actually quite easy. The code follows these steps:
Finds the date corresponding to the anniversary in the current year
If the date has already passed in the current year, adds one year to the date
To find the anniversary date in the current year, the code uses this expression:
dtmThisYear = DateSerial(Year(Now), Month(dtmDate), Day(dtmDate))
To correct the result if the date has already passed in the current year, the function uses this fragment:
If dtmThisYear < Date Then
dtmThisYear = DateAdd("yyyy", 1, dtmThisYear)
End If
Either way, dtmThisYear contains the next occurrence of the anniversary.
To try out the procedure, you might use code like the following fragment. Given that the current date is 11/12/97,
dhNextAnniversary(#5/16/56#)
returns 5/16/98 because that date has already passed in 1997.