Count Working Days with Blank End Date (1 Viewer)

byhamc

New member
Local time
Today, 23:43
Joined
Sep 23, 2010
Messages
2
I've recently found this thread http://www.access-programmers.co.uk/forums/showthread.php?s=&threadid=51941&highlight=dates with some really useful code added by Mile-O.

I've amended the GetBankHoliday function slightly to take care of Xmas / New Year dates that land at weekends and this is working fine.

I now need to get the code to run if the End Date is blank.

I've amended the code as follows:

Code:
Public Function CountDays(ByVal dteStartDate As Date, dteEndDate As Date, _
                                Optional intType As Integer) As Integer
 
    On Error GoTo Err_CountWeeks
 
    Dim dteTemp As Date, intDays As Integer
 
 
 
    dteTemp = dteStartDate
 
    If dteEndDate = 0 Then
        If intType = 1 Then
            dteEndDate = Date
        Else
            CountDays = 0
            Exit Function
        End If
    Else
    End If
 
    Do While dteTemp <> dteEndDate + 1
 
        Select Case Weekday(dteTemp)
            Case Is = 1, 7
                ' do nothing
            Case Else
                Select Case dteTemp
                    Case Is = GetBankHoliday(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)), _
                        GetBankHoliday(DateSerial(Year(dteTemp), 12, 25)), _
                        GetBankHoliday(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

The idea is to take a third 'optional' parameter which tells Access to either return a 0 or the working days from Start Date to Current Date if the End Date is blank.

My problem is that Access appears to completely skip any rows where the End Date is blank. I've added breakpoints to the code to try and work out where it's going wrong, but these don't get triggered until a 'good' record with both Start and End date is found. I've tried re-coding to take the variables as String and then Convert to Date variables, but this does nothing to help.

I believe my logic is sound, but just can't seem to get the code running properly.

Anyone got any suggestions?

Many thanks


Chris
 

JANR

Registered User.
Local time
Tomorrow, 00:43
Joined
Jan 21, 2009
Messages
1,623
First declare dteEndDate as Variant in the declaration of CountDays.

Then test for IsNull(dteEndDate)

Code:
Public Function CountDays(ByVal dteStartDate As Date, dteEndDate As [COLOR=red]Variant[/COLOR], _
                                Optional intType As Integer) As Integer
 
    On Error GoTo Err_CountWeeks
 
    Dim dteTemp As Date, intDays As Integer
 
 
 
    dteTemp = dteStartDate
 
    If [COLOR=red]IsNull(dteEndDate)[/COLOR] Then
        If intType = 1 Then
            dteEndDate = Date
        Else
            CountDays = 0
            Exit Function
        End If
    Else
    End If
...
....

JR
 

byhamc

New member
Local time
Today, 23:43
Joined
Sep 23, 2010
Messages
2
That's perfect.

Can't believe I was so close - had tried changing type to Variant after discovering that this was the only variable type that you could assign a null value to, but didn't quite have the IsNull() function right (I was using dteEndDate is Null!!)

Thanks for the help

Regards

Chris
 

DCrake

Remembered
Local time
Today, 23:43
Joined
Jun 8, 2005
Messages
8,632
This code looks very resource intensive you may be better served looking a this sample post and use the filters to get the information you need.
 

Users who are viewing this thread

Top Bottom