Business Day Function Works but needs to account for no Null End Dates - HELP?

[Lisa Perry]

Hello,

I have a business day function that I got and works great as long as the two fields that I am using it on both have dates but this is always not the case, is some cases by end date will be blank until we get a response for our customer and the code debugger points to the bolded section of the code below - does any one know how to account for the Null End Dates?

I appreciate your help....

Function:

Public Function BusinessDays(dteStartDate As Variant, dteEndDate As Variant) As Long
Dim lngYear As Long
Dim lngEYear As Long
Dim dteStart As Date, dteEnd As Date
Dim dteCurr As Date


Dim lngDay As Long
Dim lngDiff As Long
Dim lngACount As Long
Dim dteLoop As Variant
Dim blnHol As Boolean
Dim dteHoliday() As Date
Dim lngCount As Long, lngTotal As Long
Dim lngThanks As Long

dteStart = dteStartDate
dteEnd = dteEndDate


lngYear = DatePart("yyyy", dteStart)
lngEYear = DatePart("yyyy", dteEnd)

If lngYear <> lngEYear Then
lngDiff = (((lngEYear - lngYear) + 1) * 7) - 1
ReDim dteHoliday(lngDiff)
Else
ReDim dteHoliday(6)
End If

lngACount = -1

For lngCount = lngYear To lngEYear
lngACount = lngACount + 1
'July Fourth
dteHoliday(lngACount) = DateSerial(lngCount, 7, 4)

lngACount = lngACount + 1
'Christmas
dteHoliday(lngACount) = DateSerial(lngCount, 12, 25)

lngACount = lngACount + 1
'New Years
dteHoliday(lngACount) = DateSerial(lngCount, 1, 1)

lngACount = lngACount + 1
'Thanksgiving - 4th Thursday of November
lngDay = 1
lngThanks = 0
Do
If Weekday(DateSerial(lngCount, 11, lngDay)) = 5 Then
lngThanks = lngThanks + 1
End If
lngDay = lngDay + 1
Loop Until lngThanks = 4

dteHoliday(lngACount) = DateSerial(lngCount, 11, lngDay)

lngACount = lngACount + 1
'Memorial Day - Last Monday of May
lngDay = 31
Do
If Weekday(DateSerial(lngCount, 5, lngDay)) = 2 Then
dteHoliday(lngACount) = DateSerial(lngCount, 5, lngDay)
Else
lngDay = lngDay - 1
End If
Loop Until dteHoliday(lngACount) >= DateSerial(lngCount, 5, 1)

lngACount = lngACount + 1
'Labor Day - First Monday of Septemeber
lngDay = 1
Do
If Weekday(DateSerial(lngCount, 9, lngDay)) = 2 Then
dteHoliday(lngACount) = DateSerial(lngCount, 9, lngDay)
Else
lngDay = lngDay + 1
End If
Loop Until dteHoliday(lngACount) >= DateSerial(lngCount, 9, 1)
'MsgBox dteHoliday(5)

lngACount = lngACount + 1
'Easter
lngDay = (((255 - 11 * (lngCount Mod 19)) - 21) Mod 30) + 21

dteHoliday(lngACount) = DateSerial(lngCount, 3, 1) + lngDay + _
(lngDay > 48) + 6 - ((lngCount + lngCount \ 4 + _
lngDay + (lngDay > 48) + 1) Mod 7)
Next


For lngCount = 1 To DateDiff("d", dteStart, dteEnd)
dteCurr = (dteStart + lngCount)
If (Weekday(dteCurr) <> 1) And (Weekday(dteCurr) <> 7) Then
blnHol = False
For dteLoop = 0 To UBound(dteHoliday)
'MsgBox dteHoliday(dteLoop) & " " & dteLoop
If (dteHoliday(dteLoop) = dteCurr) Then
blnHol = True
End If
Next dteLoop
If blnHol = False Then
lngTotal = lngTotal + 1
'MsgBox dteCurr
End If
End If
Next lngCount
BusinessDays = lngTotal

End Function
------------------------------

Thank you!

Lisa

[RuralGuy]

Why not just test the EndDate at the beginning of the procedure and set it to whatever you want.

[Lisa Perry]

Hello again,

You helped me last time I had an issue. I do apologize but I am very new to VBA and am trying to learn and found this function for business days on line to use and it worked great until I had a blank date in the end date - could you give me an example of what you mean by "EndDate at the beginning of the procedure" to test?

Thank you for all your help, as always.

Lisa

[RuralGuy]

Something like this should work:

   .
   .
   .
   Dim dteHoliday() As Date
   Dim lngCount As Long, lngTotal As Long
   Dim lngThanks As Long

   If IsEmpty(dteEndDate) Then
      dteEndDate = Date
   End If
   
   dteStart = dteStartDate
   dteEnd = dteEndDate

[orange]

Further to Allan's comment and code--

WHAT do you want your routine to do if there is No End date. This in itself is NOT a programming issue.
It becomes a programming issue once you decide WHAT should be done when there is no end date.

Allan is pointing out that before you go into your routine, you should first check if there is an End Date.
If there is, then proceed with your routine.
If there is NO End Date, I want the program to.....???

Good luck.

[Lisa Perry]

Hello,

Thank you both - if there is no end date, I need it to be blank because eventually, once the customer responds, we will then have a date.

I apologize for my ignorance but I am very new to code and trying to learn and so appreciate everyone's help here.

Lisa

[RuralGuy]

So to the question that Orange was posing, the routine you posted should probably *not* be called when there is no EndDate. We call it "putting a wrapper on that function". That function needs to *always* return a Long Integer.

[Lisa Perry]

Would you be so kind as to show me how to do that in the function above? And, again, thank you for all your help.

[RuralGuy]

Where are you using it now. Can you post some code or SQL?

[orange]

At the start of your function

Public Function BusinessDays(dteStartDate As Variant, dteEndDate As Variant) As Long

Dim lngYear As Long

Dim lngEYear As Long

Dim dteStart As Date, dteEnd As Date

Dim dteCurr As Date

Dim lngDay As Long

Dim lngDiff As Long

Dim lngACount As Long

Dim dteLoop As Variant

Dim blnHol As Boolean

Dim dteHoliday() As Date

Dim lngCount As Long, lngTotal As Long

Dim lngThanks As Long

CheckForMissingParameters:

If IsEmpty(dteEndDate) OR isEmpty(dteStartDate) Then
debug.print "An input parameter is missing "
EndIf

AllParmsArePresentSoContinue:
dteStart = dteStartDate
.....
....

[Lisa Perry]

Thank you so much. I added the "CheckforMissingParameters, etc." code you supplied into the BusinessDays function and it runs but as soon as I add a record with no end date it errors out - I have attach a copy of my test database so you can see what it is doing if that would be more helpful. I put all the data back in the query will run. If you remove one of the end dates out of the tblAuditDetail (AE_Resp_Rcvd) and then run the query (qryResponseTime), you will see the error. Again, I am sorry for not understanding but are you all are helping me learn and I so appreciate your help.

Lisa

[RuralGuy]

Hi Lisa,

Try this db.

[Lisa Perry]

Hello,

Thank you -- I received an error when I ran the query without an end date in my table for one of my customers which I will have until our customer responds so I need the query to run even if there are no end dates and just bring back nothing in the field until an actual date is entered - does that make sense? Again, excuse my ignorance.

Thank you for your help.

Lisa

[RuralGuy]

Try it again Lisa. I change the upload.

[RuralGuy]

I had forgotten to change the Query.