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