HOWTO: Write Date Calculation Routines

ID: Q185480

The information in this article applies to:

Microsoft Visual Basic for Applications version 5.0

SUMMARY

This article shows how to include several useful date calculation routines in your application.

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

Create a new project and add a module to the project.

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

Run the project, and then press CTRL+BREAK to pause it.

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()) 
```

REFERENCES

For additional information, please see the following article(s) in the Microsoft Knowledge Base:

Q88657 Functions for Calculating and Displaying Date/Time Values

Q100136 Two Functions to Calculate Age in Months and Years

Additional query words: vba kbVBA kbVBp kbDSupport kbDSD

Keywords :
Version : WINDOWS:5.0
Platform : WINDOWS
Issue type : kbhowto