VB Snippet - Many Date Functions

[James Stanich]

' 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