Someone help please......

B

Blackwidow

Registered User.
Local time
Today, 02:31
Joined
Apr 30, 2003
Messages
149
I work as part of a the LEA's Exclusions Team... and have a database where I log all the exclusions to send letters to parents.. The function below works perfectly.. it takes the date excluded and depending on the number if days I exclude them for it returns the date that the student is due back...It also takes into account weekends and therefore if a student is excluded on a friday for two days it doesnt count sat/sun as days...

The problem I have is that I also need it not to count school holidays:
as an example school finishes on 18th of july therefore anyone excluded say 15th july for 10 days will not be due back till 2nd September cause it is a holiday... not 29th July as it is is currently returning.. what I am stuck on is how to get the function to ignore holiday dates??

I have a function below which I call up as follows..
CountWeeks([Date Excluded],[Number of Days])

Any Ideas?


Module for Countweeks below

Public Function CountWeeks(ByVal dteStartDate As Date, intDays As Integer)

On Error Goto Err_CountWeeks

Dim dteTemp As Date

dteTemp = dteStartDate

Do While intDays <> 0

Select Case WeekDay(dteTemp)
Case Is = 1, 7
' do nothing
Case Else
Select Case dteTemp
Case Is = DateSerial(Year(dteTemp), 1, 1), _
DateSerial(Year(dteTemp), 1, 2), _
DateOfEaster(Year(dteTemp)) - 2, _
DateOfEaster(Year(dteTemp)) + 1, _
GetBankHoliday(DateSerial(Year(dteTemp), 5, 1)), _
GetBankHoliday(DateSerial(Year(dteTemp), 5, 25)), _
GetBankHoliday(DateSerial(Year(dteTemp), 8, 25)), _
DateSerial(Year(dteTemp), 12, 25), _
DateSerial(Year(dteTemp), 12, 26)
' do nothing
Case Else
intDays = intDays - 1
End Select
End Select
dteTemp = dteTemp + 1
Loop

CountWeeks = dteTemp - 1 ' remove 1 due to final of loop

Exit_CountWeeks:
Exit Function

Err_CountWeeks:
MsgBox Err.Description, vbExclamation, "Error #" & Err.Number
Resume Exit_CountWeeks

End Function

Public Function DateOfEaster(ByVal intYear As Integer) As Date

On Error GoTo Err_DateOfEaster

Dim intDominical As Integer, intEpact As Integer, intQuote As Integer

intDominical = 225 - (11 * (intYear Mod 19))

' if the Dominical is greater than 50 then subtract multiples of 30 until the resulting
' new value of it is less than 51
If intDominical > 50 Then
While intDominical > 50
intDominical = intDominical - 30
Wend
End If

' if the Dominical is greater than 48 subtract 1 from it
If intDominical > 48 Then intDominical = intDominical - 1

intEpact = (intYear + Int(intYear / 4) + intDominical + 1) Mod 7

intQuote = intDominical + 7 - intEpact

' if the quote is less than 32 then Easter is in March
' if the quote is greater than 31 then the quote minus 31 is its date in April
If intQuote > 31 Then
DateOfEaster = DateSerial(intYear, 4, intQuote - 31)
Else
DateOfEaster = DateSerial(intYear, 3, intQuote)
End If

Exit_DateOfEaster:
Exit Function

Err_DateOfEaster:
MsgBox Err.Description, vbExclamation, "Error #" & Err.Number
Resume Exit_DateOfEaster

End Function

Public Function GetBankHoliday(ByRef dteBankHoliday As Date) As Date

On Error Goto Err_GetBankHoliday

Dim intCounter As Integer
For intCounter = 0 To 6
If WeekDay(dteBankHoliday + intCounter) = 2 Then
dteBankHoliday = dteBankHoliday + intCounter
Exit For
End If
Next intCounter
GetBankHoliday = dteBankHoliday

Exit_GetBankHoliday:
Exit Function

Err_GetBankHoliday:
MsgBox Err.Description, vbExclamation, "Error #" & Err.Number
Resume Exit_GetBankHoliday

End Function


Any help/suggestions much appreciated
:confused:
 
On this thread , I modified the code I gave you a while back - to disregard weekends and bank holidays and now it also disregards user defined dates.

You may want to have a look at the example in it for some ideas.
 
Holidays CONFUSED!

Hi Milo-o-phile ... Right finally got around to sorting this holiday thing.

I now have a table called tblHolidays with Startdate and end date

but not quite sure how to get it to ignore dates between the the start and end date..
 
Did you look at the example closely? The code was slightly modified to query the new table and check the date there...
 
I have compile error coming up....

Have replaced the coding with the new one...

But cant see how it is checking tblholidays for dates between start date and end date???
 
There's an extra query that selects the date it is checking as it goes through the loop. If the query returns a date then it knows that this is a holiday otherwise the day is okay.
 
I now have a runtime error 6 when it reaches intDays = intDays + 1 in the function: CountDays??
 
Blackwidow said:
I now have a runtime error 6 when it reaches intDays = intDays + 1 in the function: CountDays??
Click to expand...

Use the debugger - set check points in the code, step through it and determine what's going on. Error 6 is Overflow so my assumption is that intDays is going beyond the limit allowed for Integer values (about 37,000).

Look for values going up when they should be going down - use a small date range too - maybe just 1½ weeks with a defined holiday in the ranfe.
 
Totally in a mess here... if you get chance can you have a look at it? I have no understanding whatsoever when it comes to VbCode.. I dont undestand how the function works... so cant fix it! Totally at a loss over what to do....this is way out of my league
:(

my table is called tblholidays and has two fields one called 'start date' and one called 'end date', with the holiday start date in start date and the last day of the holiday in 'end date' have I set that up correctly?

And this is the function below....

Public Function CountDays(ByVal dteStartDate As Date, dteEndDate As Date) As Integer

'On Error GoTo Err_CountWeeks

Dim dteTemp As Date, intDays As Integer

dteTemp = dteStartDate

Do While dteTemp <> dteEndDate + 1

Select Case Weekday(dteTemp)
Case Is = 1, 7
' do nothing
Case Else
Select Case dteTemp
Case Is = DateSerial(Year(dteTemp), 1, 1), _
DateOfEaster(Year(dteTemp)) - 2, _
DateOfEaster(Year(dteTemp)) + 1, _
GetBankHoliday(DateSerial(Year(dteTemp), 5, 1)), _
GetBankHoliday(DateSerial(Year(dteTemp), 5, 25)), _
GetBankHoliday(DateSerial(Year(dteTemp), 8, 25)), _
DateSerial(Year(dteTemp), 12, 25), _
DateSerial(Year(dteTemp), 12, 26)
' do nothing
Case Else

intDays = intDays + 1
End Select
End Select
dteTemp = dteTemp + 1
Loop

CountDays = intDays

Exit_CountDays:
Exit Function

Err_CountWeeks:
MsgBox Err.Description, vbExclamation, "Error #" & Err.Number
Resume Exit_CountDays

End Function


Public Function DateOfEaster(ByVal intYear As Integer) As Date

On Error GoTo Err_DateOfEaster

Dim intDominical As Integer, intEpact As Integer, intQuote As Integer

intDominical = 225 - (11 * (intYear Mod 19))

' if the Dominical is greater than 50 then subtract multiples of 30 until the resulting
' new value of it is less than 51
If intDominical > 50 Then
While intDominical > 50
intDominical = intDominical - 30
Wend
End If

' if the Dominical is greater than 48 subtract 1 from it
If intDominical > 48 Then intDominical = intDominical - 1

intEpact = (intYear + Int(intYear / 4) + intDominical + 1) Mod 7

intQuote = intDominical + 7 - intEpact

' if the quote is less than 32 then Easter is in March
' if the quote is greater than 31 then the quote minus 31 is its date in April
If intQuote > 31 Then
DateOfEaster = DateSerial(intYear, 4, intQuote - 31)
Else
DateOfEaster = DateSerial(intYear, 3, intQuote)
End If

Exit_DateOfEaster:
Exit Function

Err_DateOfEaster:
MsgBox Err.Description, vbExclamation, "Error #" & Err.Number
Resume Exit_DateOfEaster

End Function






Public Function GetBankHoliday(ByRef dteBankHoliday As Date) As Date

On Error GoTo Err_GetBankHoliday

Dim intCounter As Integer
For intCounter = 0 To 6
If Weekday(dteBankHoliday + intCounter) = 2 Then
dteBankHoliday = dteBankHoliday + intCounter
Exit For
End If
Next intCounter
GetBankHoliday = dteBankHoliday

Exit_GetBankHoliday:
Exit Function

Err_GetBankHoliday:
MsgBox Err.Description, vbExclamation, "Error #" & Err.Number
Resume Exit_GetBankHoliday

End Function

Please help.... getting desperate now... people yelling at me:( cause I cant fix it
 
The complete code of the module is:

Code: 
Option Compare Database
Option Explicit

Public dteTemp As Date

Public Function SingleDate() As Date

    SingleDate = dteTemp

End Function


Public Function CountDays(ByVal dteStartDate As Date, dteEndDate As Date) As Integer
 
    On Error GoTo Err_CountWeeks
    
    Dim intDays As Integer
    
    If dteStartDate > dteEndDate Then
        dteTemp = dteEndDate
        dteEndDate = dteStartDate
        dteStartDate = dteTemp
    End If
        
    dteTemp = dteStartDate
    
    Do While dteTemp <> dteEndDate + 1
        
        Select Case WeekDay(dteTemp)
            Case Is = 1, 7
                ' do nothing
            Case Else
                If Not DCount("DefinedDate", "qrySelectDate") = 1 Then
                    Select Case dteTemp
                        Case Is = DateSerial(Year(dteTemp), 1, 1), _
                            DateOfEaster(Year(dteTemp)) - 2, _
                            DateOfEaster(Year(dteTemp)) + 1, _
                            GetBankHoliday(DateSerial(Year(dteTemp), 5, 1)), _
                            GetBankHoliday(DateSerial(Year(dteTemp), 5, 25)), _
                            GetBankHoliday(DateSerial(Year(dteTemp), 8, 25)), _
                            DateSerial(Year(dteTemp), 12, 25), _
                            DateSerial(Year(dteTemp), 12, 26)
                            ' do nothing
                        Case Else
                            intDays = intDays + 1
                    End Select
                End If
        End Select
        dteTemp = dteTemp + 1
    Loop
    
    CountDays = intDays

Exit_CountDays:
    Exit Function

Err_CountWeeks:
    MsgBox Err.Description, vbExclamation, "Error #" & Err.Number
    Resume Exit_CountDays
        
End Function


Public Function DateOfEaster(ByVal intYear As Integer) As Date

    On Error GoTo Err_DateOfEaster
 
    Dim intDominical As Integer, intEpact As Integer, intQuote As Integer
    
    intDominical = 225 - (11 * (intYear Mod 19))
    
    ' if the Dominical is greater than 50 then subtract multiples of 30 until the resulting
    ' new value of it is less than 51
    If intDominical > 50 Then
        While intDominical > 50
            intDominical = intDominical - 30
        Wend
    End If
    
    ' if the Dominical is greater than 48 subtract 1 from it
    If intDominical > 48 Then intDominical = intDominical - 1
    
    intEpact = (intYear + Int(intYear / 4) + intDominical + 1) Mod 7
    
    intQuote = intDominical + 7 - intEpact
    
    ' if the quote is less than 32 then Easter is in March
    ' if the quote is greater than 31 then the quote minus 31 is its date in April
    If intQuote > 31 Then
        DateOfEaster = DateSerial(intYear, 4, intQuote - 31)
    Else
        DateOfEaster = DateSerial(intYear, 3, intQuote)
    End If

Exit_DateOfEaster:
    Exit Function

Err_DateOfEaster:
    MsgBox Err.Description, vbExclamation, "Error #" & Err.Number
    Resume Exit_DateOfEaster

End Function

Public Function GetBankHoliday(ByRef dteBankHoliday As Date) As Date

    On Error GoTo Err_GetBankHoliday

   Dim intCounter As Integer
    For intCounter = 0 To 6
        If WeekDay(dteBankHoliday + intCounter) = 2 Then
            dteBankHoliday = dteBankHoliday + intCounter
            Exit For
        End If
    Next intCounter
    GetBankHoliday = dteBankHoliday

Exit_GetBankHoliday:
    Exit Function

Err_GetBankHoliday:
    MsgBox Err.Description, vbExclamation, "Error #" & Err.Number
    Resume Exit_GetBankHoliday

End Function


The table only has ONE field. Each individual date that you wish to exclude is a record in this table. You would need to put the range in the table manually.
 
Ok let me get this striaght... instead of having a holiday start date and a holiday end date... I have one field callled??????? and I put each holiday date in tblholidays manually? this correct?
 
Yes, but it is possible to code.
 
just one more thing.... (promise) (i hope)

How does it know to look at tblholidays for these dates???? or have you called it something else? and what should the date field be called that holds holiday dates to make it all work?
 
I called my table: tblCustomHolidays with a field called: DefinedDate.
 
right imported your holiday dates database into mine... and put the dates in...

How do I call the function now? i used to call it =CountWeeks([Date Excluded],[Number of Days]) have tried calling =CountDays([Date Excluded],[Number of Days])
But neither works......

(so close yet so far....:))
 
Ah! You are working in a slightly different way from the example. The example counts the difference between dates; you are returning the date so many days ahead.

Wait 5 mins...;)
 
Modified for your situation...

Code: 
Public dteTemp As Date

Public Function SingleDate() As Date

    SingleDate = dteTemp

End Function


Public Function CountDays(ByVal dteStartDate As Date, intDays As Integer) As Date
 
    On Error GoTo Err_CountWeeks
        
    dteTemp = dteStartDate

    Do While intDays <> 0
        Select Case WeekDay(dteTemp)
            Case Is = 1, 7
                ' do nothing
            Case Else
                If Not DCount("DefinedDate", "qrySelectDate") = 1 Then
                    Select Case dteTemp
                        Case Is = DateSerial(Year(dteTemp), 1, 1), _
                            DateOfEaster(Year(dteTemp)) - 2, _
                            DateOfEaster(Year(dteTemp)) + 1, _
                            GetBankHoliday(DateSerial(Year(dteTemp), 5, 1)), _
                            GetBankHoliday(DateSerial(Year(dteTemp), 5, 25)), _
                            GetBankHoliday(DateSerial(Year(dteTemp), 8, 25)), _
                            DateSerial(Year(dteTemp), 12, 25), _
                            DateSerial(Year(dteTemp), 12, 26)
                            ' do nothing
                        Case Else
                            intDays = intDays - 1
                    End Select
                End If
        End Select
        dteTemp = dteTemp + 1
    Loop
    
    CountDays = dteTemp

Exit_CountDays:
    Exit Function

Err_CountWeeks:
    MsgBox Err.Description, vbExclamation, "Error #" & Err.Number
    Resume Exit_CountDays
        
End Function


Public Function DateOfEaster(ByVal intYear As Integer) As Date

    On Error GoTo Err_DateOfEaster
 
    Dim intDominical As Integer, intEpact As Integer, intQuote As Integer
    
    intDominical = 225 - (11 * (intYear Mod 19))
    
    ' if the Dominical is greater than 50 then subtract multiples of 30 until the resulting
    ' new value of it is less than 51
    If intDominical > 50 Then
        While intDominical > 50
            intDominical = intDominical - 30
        Wend
    End If
    
    ' if the Dominical is greater than 48 subtract 1 from it
    If intDominical > 48 Then intDominical = intDominical - 1
    
    intEpact = (intYear + Int(intYear / 4) + intDominical + 1) Mod 7
    
    intQuote = intDominical + 7 - intEpact
    
    ' if the quote is less than 32 then Easter is in March
    ' if the quote is greater than 31 then the quote minus 31 is its date in April
    If intQuote > 31 Then
        DateOfEaster = DateSerial(intYear, 4, intQuote - 31)
    Else
        DateOfEaster = DateSerial(intYear, 3, intQuote)
    End If

Exit_DateOfEaster:
    Exit Function

Err_DateOfEaster:
    MsgBox Err.Description, vbExclamation, "Error #" & Err.Number
    Resume Exit_DateOfEaster

End Function

Public Function GetBankHoliday(ByRef dteBankHoliday As Date) As Date

    On Error GoTo Err_GetBankHoliday

   Dim intCounter As Integer
    For intCounter = 0 To 6
        If WeekDay(dteBankHoliday + intCounter) = 2 Then
            dteBankHoliday = dteBankHoliday + intCounter
            Exit For
        End If
    Next intCounter
    GetBankHoliday = dteBankHoliday

Exit_GetBankHoliday:
    Exit Function

Err_GetBankHoliday:
    MsgBox Err.Description, vbExclamation, "Error #" & Err.Number
    Resume Exit_GetBankHoliday

End Function
 
Did anyone ever tell you that you are the most wonderful job life-saver I have ever had the pleasure to converse with:)

Are you married?


Thank you ever so much!!!


(incase you havent already realised.... it is now working!)
 
You must log in or register to reply here.

Similar threads

Feral
Solved Finding Tenure Time
2
Replies
21
Views
1,802
Feral
Feral
A
Filter Records
Replies
1
Views
673
June7
June7
A
Solved Code cannot differentiate between regional dates
Replies
5
Views
990
Ajabu
A
R
Function for a form text box
Replies
7
Views
1,502
moke123
moke123
P
HELP-Run-Time Error "3048" - cannot open anymore databases following Microsoft Update.
Replies
2
Views
1,134
Minty
Minty

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom