INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Jobs

How To

Build a Table of Holidays by scking
Posted: 28 Jul 05 (Edited 8 Aug 05)

Any rigorous scheduling function requires that the application only schedule activities on a workday.  The knowledgebase and many other applications require that a table be developed that contains all the holidays for a given period.  My application required scheduling events many years in advance so I either needed to manually build the holidays table or build one programmatically.  the following code will load a table called tblHolidays with the date, name, and day of a given set of holidays for a year.  The supplementary functions allow a user to drive the main function to build holidays for an integer number of years starting with this year and also get the day of the holiday during the loading process.

There are three main types of searches to determine a holiday.  1) On a specific date or the Monday following,
2) On the x occurrence of a day in a given month, 3) on the last occurence of a day in a given month.  You can therefore use the template snippets within the function BuildHolidayList to create the code for other holidays.  There are sites on the internet that will provide the rules for determining various holidays.

My internet search for this capability failed so I developed this one.  It would be relatively easy to add holidays or to tailor the function to allow a return of true/false if a given day was a holiday.

You would need to modify the error handling to conform to whatever functionality your applications use.

TSQL Script to create the table:
CREATE TABLE tblHolidays
    (
    ID int IDENTITY(1, 1),
    HolidayDate datetime,
    Name varchar(50),
    Weekday varchar(9)
    )

Public Type HolidayData
    dtDate As Date
    strName As String
    strWeekday As String
End Type
Dim vHolidayInfo(8) As HolidayData

Public Function BuildHolidayList(BuildYear As Long)

    Dim lngDay As Long
    Dim intWeekday As Integer
    Dim intMondayCount As Integer
    Dim intThursdayCount As Integer
    Dim dtDate As Date
    Dim strSQL As String

On Error GoTo HandleErr

    ' Get New Year's Day Holiday
    ' 1/1 or following Monday
    dtDate = CDate("1/1/" & CStr(BuildYear))
    With vHolidayInfo(0)
        .dtDate = GetMondayFollowing(dtDate)
        .strName = "New Year's Day"
        .strWeekday = GetWeekday(.dtDate)
    End With
    
    ' Get MLK Holiday
    ' Third Monday in January
    dtDate = CDate("1/1/" & CStr(BuildYear))
    For lngDay = 0 To 30
        intWeekday = Weekday(dtDate + lngDay)
        If intWeekday = vbMonday Then
            With vHolidayInfo(1)
                .dtDate = dtDate + lngDay + 14
                .strName = "Martin Luther King's Birthday"
                .strWeekday = GetWeekday(.dtDate)
            End With
            Exit For
        End If
    Next lngDay
    
    ' Third Monday in February
    dtDate = CDate("2/1/" & CStr(BuildYear))
    For lngDay = 0 To 27
        intWeekday = Weekday(dtDate + lngDay)
        If intWeekday = vbMonday Then
            With vHolidayInfo(2)
                .dtDate = dtDate + lngDay + 14
                .strName = "President's Day"
                .strWeekday = GetWeekday(.dtDate)
            End With
            Exit For
        End If
    Next lngDay
    
    ' Last Monday in May
    dtDate = CDate("5/1/" & CStr(BuildYear))
    For lngDay = 0 To 31
        intWeekday = Weekday(dtDate + lngDay)
        If intWeekday = vbMonday Then
            With vHolidayInfo(3)
                .dtDate = dtDate + lngDay
                .strName = "Memorial Day"
                .strWeekday = GetWeekday(.dtDate)
            End With
        End If
    Next lngDay
    
    dtDate = CDate("7/4/" & CStr(BuildYear))
    With vHolidayInfo(4)
        .dtDate = GetMondayFollowing(dtDate)
        .strName = "Independence Day"
        .strWeekday = GetWeekday(.dtDate)
    End With
    
    ' First Monday in September
    dtDate = CDate("9/1/" & CStr(BuildYear))
    For lngDay = 0 To 29
        intWeekday = Weekday(dtDate + lngDay)
        If intWeekday = vbMonday Then
            With vHolidayInfo(5)
                .dtDate = dtDate + lngDay
                .strName = "Labor Day"
                .strWeekday = GetWeekday(.dtDate)
            End With
            Exit For
        End If
    Next lngDay
    
    ' First Fourth Thursday in November
    dtDate = CDate("11/1/" & CStr(BuildYear))
    intThursdayCount = 0
    For lngDay = 0 To 31
        intWeekday = Weekday(dtDate + lngDay)
        If intWeekday = vbThursday Then
            intThursdayCount = intThursdayCount + 1
            If intThursdayCount = 4 Then
                With vHolidayInfo(6)
                    .dtDate = dtDate + lngDay
                    .strName = "Thanksgiving Day"
                    .strWeekday = GetWeekday(.dtDate)
                End With
                With vHolidayInfo(7)
                    .dtDate = dtDate + lngDay + 1
                    .strName = "Day-After Thanksgiving"
                    .strWeekday = GetWeekday(.dtDate)
                End With
                Exit For
            End If
        End If
    Next lngDay
    
    dtDate = CDate("12/25/" & CStr(BuildYear))
    With vHolidayInfo(8)
        .dtDate = GetMondayFollowing(dtDate)
        .strName = "Christmas Day"
        .strWeekday = GetWeekday(.dtDate)
    End With
    
    strSQL = "DELETE FROM tblHolidays WHERE YEAR(HolidayDate) IN (" & CLng(BuildYear) & ")"
    DoCmd.RunSQL strSQL
    
    For lngDay = 0 To 7
        strSQL = "INSERT INTO tblHolidays (HolidayDate, Name, Weekday) " _
            & "VALUES (CAST('" & CStr(vHolidayInfo(lngDay).dtDate) _
            & "' As datetime), '" & vHolidayInfo(lngDay).strName & "', '" _
            & vHolidayInfo(lngDay).strWeekday & "')"
        DoCmd.RunSQL strSQL
    Next lngDay
   
Exit_Proc:
    Exit Function

HandleErr:
    Select Case Err.Number
    Case Else
        Call ErrorLog("basSchedule_BuildHolidayList", Err)
    End Select
    Resume Exit_Proc
    Resume
    
End Function

Public Function GetWeekday(dtDate As Date) As String

    Dim strWeekday As String
    Dim intWeekday As Integer
    intWeekday = Weekday(dtDate)

On Error GoTo HandleErr

    Select Case intWeekday
        Case vbMonday
            strWeekday = "Monday"
        Case vbTuesday
            strWeekday = "Tuesday"
        Case vbWednesday
            strWeekday = "Wednesday"
        Case vbThursday
            strWeekday = "Thursday"
        Case vbFriday
            strWeekday = "Friday"
        Case vbSaturday
            strWeekday = "Saturday"
        Case vbSunday
            strWeekday = "Sunday"
        Case Else
            strWeekday = "Unknown"
    End Select
    GetWeekday = strWeekday
   
Exit_Proc:
    Exit Function

HandleErr:
    Select Case Err.Number
    Case Else
        Call ErrorLog("basSchedule_GetWeekday", Err)
    End Select
    Resume Exit_Proc
    Resume
    
End Function

Public Function BuildHolidayLists(lngYears As Long)

    Dim lngYear As Long
    lngYear = Year(Date)
    For lngYears = 0 To lngYears - 1
        Call BuildHolidayList(lngYear + lngYears)
    Next lngYears
    
End Function

Public Function GetMondayFollowing(dtDate As Date) As Date
      
On Error GoTo HandleErr

      'vbSaturday = 7
      'vbSunday = 0
      Dim intDayOfWeek
      
      intDayOfWeek = Weekday(dtDate)
      Select Case intDayOfWeek
          Case vbMonday To vbFriday
              GetMondayFollowing = dtDate
          Case vbSaturday
              GetMondayFollowing = dtDate + 2
          Case vbSunday
              GetMondayFollowing = dtDate + 1
      End Select
     
Exit_Proc:
    Exit Function

HandleErr:
    Select Case Err.Number
    Case Else
        Call ErrorLog("basSchedule_GetMondayFollowing", Err)
    End Select
    Resume Exit_Proc
    Resume
End Function

Back to Microsoft: Access Modules (VBA Coding) FAQ Index
Back to Microsoft: Access Modules (VBA Coding) Forum

My Archive

Resources

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close