' Taken from Microsoft Knowledgebase Article ID: Q185480
'Age Age in years.
'DaysInMonth The number of days in the current month.
'DaysInMonth2 Alternate method.
'EndOfMonth Returns the date for the last day of the current month.
'EndOfWeek Returns the date for the last day in the current week.
'LastBusDay Returns the date for the last business day (Mon-Fri)
' in the current month.
'LeapYear Returns True or False if the year is a leap year.
'LeapYear2 Alternate method.
'NextDay Returns the date for the next day (Sun...Sat) after the
' current date.
'NextDay1 Returns the date for the next day (Sun...Sat) on or
' after the current date.
'PriorDay Returns the date for the last day (Sun...Sat) before
' the current date.
'PriorDay1 Returns the date for the last day (Sun...Sat) on or
' before the current date.
'StartOfMonth Returns the date for the first day of the current
' month.
'StartOfWeek Returns the date for the first day of the current week.

Function Age(ByVal Bdate As Date, ByVal DateToday As Date) As Long
' Doesn't handle negative date ranges i.e. Bdate > DateToday.
If Month(DateToday) < Month(Bdate) _
Or (Month(DateToday) = Month(Bdate) _
And Day(DateToday) < Day(Bdate)) Then
Age = Year(DateToday) - Year(Bdate) - 1
Else
Age = Year(DateToday) - Year(Bdate)
End If
End Function

Function DaysInMonth(ByVal D As Date) As Long
' Requires a date argument because February can change
' if it's a leap year.
Select Case Month(D)
Case 2
If LeapYear(Year(D)) Then
DaysInMonth = 29
Else
DaysInMonth = 28
End If
Case 4, 6, 9, 11
DaysInMonth = 30
Case 1, 3, 5, 7, 8, 10, 12
DaysInMonth = 31
End Select
End Function

Function DaysInMonth2(ByVal D As Date) As Long
' Requires a date argument because February can change
' if it's a leap year.
DaysInMonth2 = Day(DateSerial(Year(D), Month(D) + 1, 0))
End Function

Function EndOfMonth(ByVal D As Date) As Date
EndOfMonth = DateSerial(Year(D), Month(D) + 1, 0)
End Function

Function EndOfWeek(ByVal D As Date) As Date
EndOfWeek = D - Weekday(D) + 7
End Function

Function LastBusDay(ByVal D As Date) As Date
Dim D2 As Variant
D2 = DateSerial(Year(D), Month(D) + 1, 0)
Do While Weekday(D2) = 1 Or Weekday(D2) = 7
D2 = D2 - 1
Loop
LastBusDay = D2
End Function

Function LeapYear(ByVal YYYY As Long) As Boolean
LeapYear = YYYY Mod 4 = 0 _
And (YYYY Mod 100 <> 0 Or YYYY Mod 400 = 0)
End Function

Function LeapYear2(ByVal YYYY As Long) As Boolean
LeapYear2 = Month(DateSerial(YYYY, 2, 29)) = 2
End Function

Function NextDay(ByVal D As Date, ByVal DayCode As Long) As Date
' DayCode (1=Sun ... 7=Sat) or use vbSunday...vbSaturday.
NextDay = D - Weekday(D) + DayCode + _
IIf(Weekday(D) < DayCode, 0, 7)
End Function

Function NextDay1(ByVal D As Date, ByVal DayCode As Long) As Date
NextDay1 = D - Weekday(D) + DayCode + _
IIf(Weekday(D) <= DayCode, 0, 7)
End Function

Function PriorDay(ByVal D As Date, ByVal DayCode As Long) As Date
PriorDay = D - Weekday(D) + DayCode - _
IIf(Weekday(D) > DayCode, 0, 7)
End Function

Function PriorDay1(ByVal D As Date, ByVal DayCode As Long) As Date
PriorDay1 = D - Weekday(D) + DayCode - _
IIf(Weekday(D) >= DayCode, 0, 7)
End Function

Function StartOfMonth(ByVal D As Date) As Date
StartOfMonth = DateSerial(Year(D), Month(D), 1)
End Function

Function StartOfWeek(ByVal D As Date) As Date
StartOfWeek = D - Weekday(D) + 1
End Function