Calling Milo-O-phile

[Blackwidow]

I have a code below supplied by Milo-O-Phile

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

My problem is that this is returning weekend dates and it shouldnt be... (been on holiday thats why you've had a break!)

 

[Mile-O]

Not got much time myself - going into a meeting shortly but I'll give you this:

It's a class module that does what you want.

All you need to do is call the function in the accompanying module - basDateFunctions

 

[Blackwidow]

thanks honey..

will take a look

 

[Oldsoftboss]

Honey hey.....

 

[Mile-O]

Honey hey.....

It happens...

 

[Cosmos75]

It happens...

Mile-O-Phile,
You may want to be careful when a female with the nick-name Blackwidow calls you "honey"...

 

[Blackwidow]

will call anyone honey if they can fix my problem

 

[Oldsoftboss]

Never met anyone that is remotely interested in 'womens problems'

 

[Rich]

Never met anyone that is remotely interested in 'womens problems'

The trouble is, there are too many of them

 

[Mile-O]

Just saying that the code in the Class Module on this thread's download is much better than having all that other code in a standard module.

To use the class module, you need to

Public Function GetExpectedDays(ByVal dteStart As Date, intNumberOfDays As Integer) As Date

Dim objDates As CDates
Set objDates = New CDates

GetExpectedDays = objDate.GetDate(dteStart, intNumberOfDays, False)

End Function

 

[Blackwidow]

Stuck

Erm........ it ain't working....could someone be nice and take a look.....
Pretty Pretty Please

 

[Mile-O]

I thought you were wanting to calculate a date in the future: this way:

 

[Blackwidow]

ok.... managed to open it... your form returns weekend dates though...

 

[Mile-O]

In the module called basDateFunctions change the line:

GetExpectedDays = objDate.GetDate(dteStart, intNumberOfDays, False)

to

GetExpectedDays = objDate.GetDate(dteStart, intNumberOfDays, True)

 

[Blackwidow]

Not that you want to hear this at all but it is still calculating weekends.....

 

[Mile-O]

Think I've got is now...

In the Class Module: CDates there is a function called GetDate

Change the line:

GetDate = dteTemp

to

GetDate = DateAdd("d", -1, dteTemp)

The reason for this is that the loop adds an extra day to the final result which wasn't being taken off (and resulted in Saturday being a possible result.)

 

[Blackwidow]

Will this also take into account the holiday dates in the table?? Or am I back to square one again?

 

[Mile-O]

Ah! Sh*t! Extra holiday dayes in a table...

Should all be fixed now...

 

[Misty]

Day count

Using the last posted db, with the date span being from 2/1/03, 20 work days minus weekends and the 2/5/03 holiday would be the date of 3/03/03 wouldn't it? Using the db, I get 3/04/03.

Am I just not seeing something?

M

 

[Mile-O]

You are counting the first date - there is a parameter called Inclusive in the Class Module's GetDate function. True indicates that you would like to start from the date specified and include it; False indicates that you would like to start from the date specified and ignore it. The default is False.