Solved

Visual Basic - holiday adjustment

Posted on 2004-08-02
7
1,179 Views
Last Modified: 2013-11-25
I need only for the following holidays:
new year  - jan 01
christmas - dec 25
thanksgiving - last thursday
labor day
memorial day

I have a VB 6.0 program that reads a sql (oracle) and exceutes it and then puts the results in a csv file.
Now I want to send the value to a parameter in my sql code from vb code(I have a parameter called &x in the where clause).
The parameter will be 42 if there are no holidays during the 42 days.(which is nothing but 30 business days) But if there were any publice holidays then the the value of the parametr changes to (42 -1) if there was just one holiday or
(42-2) if there were 2 holidays.

I have found the alogorithm that computes holidays, but I am getting some errors.
So pl. update the changes in my code for this:
Algo:
To calculate the day on which a particular date falls, the following
algorithm may be used (the divisions are integer divisions, in which
remainders are discarded; % means all we want is the remainder):
 
a = (14 - month) / 12
y = year - a
m = month + 12*a - 2
For Julian calendar: d = (5 + day + y + y/4 + (31*m)/12) % 7
For Gregorian calendar: d = (day + y + y/4 - y/100 + y/400 + (31*m)/12) % 7
 
The value of d is 0 for a Sunday, 1 for a Monday, 2 for a Tuesday, etc.

Then I sat down and came up with this formula in order to calculate dates such as "The third Monday in January". I suspect these have been derived and written down somewhere by someone else; in any case, these formula are easy to derive, and useful for computing various holidays in electronic calendars.
First, let the above formula be called DoW(year,month,dayinmonth), which specifies that its arguements are the year (in numerical form), the month (1-12) and the day in the month (day number in month, 1-31).
In all the below formula, the following common-sense relation is used: -1%7 = 6; -2%7=5; .. -6%7=1, -7%7=0. Also, an N-day is a Sunday (N=0), through Saturday (N=6). The most generic formula is then:
Date In Month that is an N-day ON OR AFTER date Year-Month-Day =
Day + (N - DoW(Year,Month,Day))%7 .

Date In Month that is an N-day ON OR BEFORE date Year-Month-Day =
Day - (DoW(Year,Month,Day) - N)%7 .


These lead to quick formulae for determining the date of the first, second, third, fourth and fifth occurence of a Sunday, Monday, etc., in any particular month:
First N-day: N1 = 1 + (N - DoW(Year,Month,1))%7 ;
2nd N-day : N2 = 8 + (N - DoW(Year,Month,8))%7 ;
3rd N-day : N3 = 15 + (N - DoW(Year,Month,15))%7 ;
4th N-day : N4 = 22 + (N - DoW(Year,Month,22))%7 ;
5th N-day : N5 = 29 + (N - DoW(Year,Month,29))%7 .
(Note: Use common sense when trying to calculate the fifth N-day: check to see if the value you obtain is greater than the number of days in the month; if it is, the there is no fifth N-day in that month.)


Two visitors to this page, Timothy Barmann and Bobby Cossum, have independently suggested that the above five equations can be simplified into just one equation. Let Q be the occurence (first, second, third, fourth, fifth), and N will still represent the day of the week, as above. Then,
the Q-th N-day: NQ = 1 + (Q-1)*7 + (N - DoW(Year,Month,1))%7;
or equivalently
the Q-th N-day: NQ = 7*Q - 6 + (N - DoW(Year,Month,1))%7. So, to find the first Friday using the above equations, use Q=1, N=5; the third Monday is found using Q=3, N=1, etc.
In order to find, for example, the LAST Monday in a month, we need to know the length of the month; for all months except February, this is, of course, fixed. In any case, we have:
ND=Number of last day in month;
Last N-Day : NL = ND - (DoW(Year,Month,ND) - N)%7 .
Example: What date is the last Monday in May, 1996?
1. The last day in May is May 31, so ND=31.
2. Monday is what we want, so N=1
3. The day of the week of May 31, 1996 is found by following the first algorithm above: a=(14-5)/12=0
y=1996-a=1996-0=1996
m=5+0-2=3
d=(31+1996+499-19+4+(31*3)/12)%7= 5
So, May 31st is a Friday; then
4. NL=31-(5-1)%7=31-4=27
5. So, the last Monday in 1996 May is May 27.

0
Comment
Question by:Sara_j_11
  • 2
  • 2
7 Comments
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 11701069
Not sure what your error is.

Perhaps you should post your code, indicating where and how it fails.
In the dissertation that you post, the authors seem to be unaware that the number of the day of the week for a given date is simply deriven in VB:

Weekday(GivenDate)
0
 
LVL 3

Expert Comment

by:leojl
ID: 11701761

hello

My neighbor has a bible type book which shows the date for Easter for about 400
years. Easter is not on your list, but I use that as an example of the most simple
cost effective way to deal with your requirement. Just build a file or table with your
dates of interest. Then address that table with start and end dates of interest and
count the date tick marks.

It is perhaps more interesting to create a formula or general algorithm, but some
requirements are much better met with a simpe hard-wired table.

leojl
0
 
LVL 76

Accepted Solution

by:
GrahamSkan earned 500 total points
ID: 11701878
'deriven'? I think I meant 'derived'

This is my code to find all the Bank Holidays in the UK, except for Scotland's New Year's Day plus one.

Option Explicit

Public Holidays() As Date

Public Function FindEaster(GivenYear As Integer, FoundMonth As Integer, FoundDay As Integer) As Date
Dim YearMod19 As Integer
Dim Century As Integer
Dim YearInCentury As Integer
Dim QuadCenturyCount As Integer
Dim CenturyinQuad As Integer
Dim CenturyAdjuster
Dim h As Integer
Dim AdjustedCentury As Integer
Dim h1 As Integer
Dim h2 As Integer
Dim hh As Integer
Dim i As Integer
Dim k As Integer
Dim l As Integer
Dim ll As Integer
Dim pp As Integer
Dim m As String
    YearMod19 = GivenYear Mod 19
    Century = Int(GivenYear / 100)
    YearInCentury = GivenYear Mod 100
    QuadCenturyCount = Int(Century / 4)
    CenturyinQuad = Century Mod 4
    CenturyAdjuster = Int(((8 * Century) + 13) / 25)
    AdjustedCentury = Century - QuadCenturyCount - CenturyAdjuster
    If GivenYear < 1583 Then AdjustedCentury = 30
    h1 = Int(((11 * AdjustedCentury) - 4) / 30)
    h2 = Int(((7 * YearMod19) + h1 + 6) / 11)
    hh = 19 * YearMod19 + AdjustedCentury + 15 - h2
    h = hh Mod 29
    i = Int(YearInCentury / 4)
    k = YearInCentury Mod 4
    ll = 32 + 2 * CenturyinQuad + 2 * i - k - h
    If GivenYear < 1583 Then ll = 34 + Century + 2 * i - h - k
    l = ll Mod 7
    FoundMonth = Int((90 + h + l) / 25)
    pp = 19 + h + l + FoundMonth
    FoundDay = pp Mod 32
    Select Case FoundMonth
        Case 4
            m$ = "APRIL"
        Case 3
            m$ = "MARCH"
    End Select
    FindEaster = CDate(FoundDay & "/" & FoundMonth & "/" & GivenYear)
End Function



Public Sub GetHolidays(HolidayYear As Integer, Holidays() As Date)
Dim m As Integer
Dim d As Integer
    ReDim Holidays(0)
    'New Year's Day
    Holidays(0) = NextWorkingDay(CDate("1/1/" & HolidayYear))
    'Good Friday
    ReDim Preserve Holidays(1)
    Holidays(1) = DateAdd("d", -2, FindEaster(HolidayYear, m, d))
    'Easter Monday
    ReDim Preserve Holidays(2)
    Holidays(2) = DateAdd("d", 1, FindEaster(HolidayYear, m, d))
    'May Day
    ReDim Preserve Holidays(3)
    Holidays(3) = NextMonday(CDate("1/5/" & HolidayYear))
    'Late spring
    ReDim Preserve Holidays(4)
    Holidays(4) = PriorMonday(CDate("1/6/" & HolidayYear))
    'Late summer
    ReDim Preserve Holidays(5)
    Holidays(5) = PriorMonday(CDate("1/9/" & HolidayYear))
    'Christmas Day
    ReDim Preserve Holidays(6)
    Holidays(6) = NextWorkingDay(CDate("25/12/" & HolidayYear))
    'Boxing Day
    ReDim Preserve Holidays(7)
    Holidays(7) = NextWorkingDay(CDate("26/12/" & HolidayYear))
End Sub


Public Function NextWorkingDay(DefaultDay As Double) As Double
    Dim Flag As Boolean
    Dim WorkingDay As Date
    Dim a As Integer
    WorkingDay = DefaultDay
    Do Until Flag
        Flag = True
        Select Case Weekday(WorkingDay)
            Case 1, 7
                WorkingDay = DateAdd("d", 1, WorkingDay)
                Flag = False
        End Select
        For a = 0 To UBound(Holidays)
            If Holidays(a) = WorkingDay Then
                WorkingDay = DateAdd("d", 1, WorkingDay)
                Flag = False
                Exit For
            End If
        Next a
    Loop
    NextWorkingDay = WorkingDay
End Function

Public Function NextMonday(DefaultDate As Date) As Date
    Dim Wd As Integer
    Wd = Weekday(DefaultDate)
    NextMonday = DateAdd("d", (9 - Wd) Mod 7, DefaultDate)
End Function

Public Function PriorMonday(DefaultDate As Date) As Date
    Dim Wd As Integer
    Wd = Weekday(DefaultDate)
    PriorMonday = DateAdd("d", -((5 + Wd) Mod 7), DefaultDate)
End Function


0
 
LVL 3

Expert Comment

by:leojl
ID: 12470045

 I need only for the following holidays:
new year  - jan 01
christmas - dec 25
thanksgiving - last thursday
labor day
memorial day

how long would it take to build a table for 10, 20 or 50 years ??

I just want EE people to consider that sometimes a brute force technique
is the most cost effective way to deal with a requirement.

leo
0

Featured Post

Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

Join & Write a Comment

The debugging module of the VB 6 IDE can be accessed by way of the Debug menu item. That menu item can normally be found in the IDE's main menu line as shown in this picture.   There is also a companion Debug Toolbar that looks like the followin…
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
This is Part 3 in a 3-part series on Experts Exchange to discuss error handling in VBA code written for Excel. Part 1 of this series discussed basic error handling code using VBA. http://www.experts-exchange.com/videos/1478/Excel-Error-Handlin…

747 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now