CountWeeks function continued.....

Blackwidow

Registered User.
Local time
Today, 06:04
Joined
Apr 30, 2003
Messages
149
Ok... rephrasing my problem...

I have a function below which I call up as follows..
CountWeeks([Date Excluded],[Number of Days]) (thanks to Mile - o-phile)

I have just created a table called tblholidays which has a start date, an End date and Due Back date field.. as an example school finishes on 18th of july therefore anyone excluded say today 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 the dates I have put in the new tblholiday table??

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
 
Last edited:

Users who are viewing this thread

Back
Top Bottom