How To Write Date Calculation Routines (185480)

MORE INFORMATION

Microsoft provides programming examples for illustration only, without warranty either expressed or implied, including, but not limited to, the implied warranties of merchantability and/or fitness for a particular purpose. This article assumes that you are familiar with the programming language being demonstrated and the tools used to create and debug procedures.

The procedures included are:

   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.
				

Step-by-Step Example

1. Create a new project and add a module to the project.
2. Add the following code to the module:

   Sample Code

              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

3. Run the project, and then press CTRL+BREAK to pause it.
4. You can test the functions by typing each of the following expressions in the Immediate window:

   ?LeapYear(1998)
   ?NextDay(Date(), vbSaturday)
   ?EndOfMonth(Date())
   ?Age(#12/1/1966#, Date())

   or use the following code as a sample of how to call one of the date calculation functions from your code:

         Dim bLeapYear As Boolean, D As Date, iAge As Long
         bLeapYear = LeapYear(Year(Date()))
         D = EndOfMonth(Date())
         iAge = Age(#12/1/1966#, Date())