' 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
