Hello,

I have a form where people enter information on a new work order. Among other things, they must enter the status of the order (open, closed, dead, more info requested), the date the order was received, and the date the order was completed/dead if applicable.

I'm trying to write a routine that makes sure the correct date fields are filled out based off the status that is selected. So if the status is "closed" or "dead", access wont save the record unless there is both a received date and a completed date, but it would not require a completion date if the status is "open" or "more info pending".

My problem is that this works fine for everything except "closed". If the user changes the status to "closed" then access appears to get stuck in a loop and seizes up.

You'll notice that this code contains no select case despite the title - it did originally, but when that froze I tried converting it to If-Then in hopes of resolution. No dice.

Your help is greatly appreciated!

Thanks,
CF



Dim X As Integer

If Me.Status = "Open" Then
If Not IsNull([DateCompleted]) Then
X = MsgBox("A completion date has already been entered for this transaction. If this entry has been made in error and you would like to reopen this transaction, please select 'OK'. If you are processing a new transaction, please select 'Cancel' and create a new transaction.", vbOKCancel, vbInformation)

If X = vbOK Then
Me.DateCompleted.Value = ""
Me.CompletionTime.Value = ""
End If
End If
End If

If Me.Status = "Closed" Then
If IsNull([DateCompleted]) Then
Me.DateCompleted.Value = Date
BusinessDays DateReceived, DateCompleted
End If
End If

If Me.Status = "More Info Requested" Then
If Not IsNull([DateCompleted]) Then
X = MsgBox("A completion date has already been entered for this transaction. If this entry has been made in error and you would like to reopen this transaction, please select 'OK'. If you are processing a new transaction, please select 'Cancel' and create a new transaction.", vbOKCancel + vbInformation)

If X = vbOK Then
Me.DateCompleted.Value = ""
Me.CompletionTime.Value = ""
End If
End If
End If

If Me.Status = "Dead" Then
If IsNull([DateCompleted]) Then
Me.DateCompleted.Value = Date
BusinessDays DateReceived, DateCompleted
End If
End If

Have you put a break point in the code to see where you are getting stuck. Are you using the BusinessDays function that I posted on the site?

I see a couple of issues in the code posted. I would think that the DateCompleted field would be a DateTime field (which is a special type of numeric field) and you are trying to set it to a string with Me.DateCompleted.Value = "". You have also not included the code for BusinessDays DateReceived, DateCompleted which could be a source of your problem.

The code looks okay, although I'd definitely switch it back to CASE statements. You can also replace the If Null/If Not Null checks with NZ functions. Regardless of style, put a breakpoint on the "If Closed" section, enter a dummy record that will trigger that (set it to closed), and then trace it through. My guess is that BusinessDays, a custom something you wrote, is the culprit, but you didn't post the code for that.

I am using your BusinessDays function! Thank you so much for that. My boss was beside himself impressed. I just casually told him, "I know a guy." :) I hope you don't mind - all appropriate credits are given in the code.

As for entering the break, I'm not sure how to do that.


**Wow, people post to fast for me to respond! I'm including the BusinessDays code, although that appeared to work fine before I started adding this check thing.

As for the Date/Time field, how would I go about clearing it while preserving its formatting without setting it to ""?


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

'The following code was graciously posted by KeithG at http://www.access-programmers.co.uk

Dim lngYear As Long
Dim dteStart As Date
Dim dteEnd As Date
Dim dteCurr As Date
Dim lngDay As Long
Dim dteLoop As Variant
Dim blnHol As Boolean
Dim dteHoliday(6) As Date
Dim lngCount As Long
Dim lngTotal As Long

dteStart = Form_frmTransactions![DateReceived]
dteEnd = Form_frmTransactions![DateCompleted]

lngYear = DatePart("yyyy", dteStart)

'July Fourth
dteHoliday(0) = DateSerial(lngYear, 7, 4)

'Christmas
dteHoliday(1) = DateSerial(lngYear, 12, 25)

'New Years
dteHoliday(2) = DateSerial(lngYear, 1, 1)

'Thanksgiving - Last Thursday of November
dteHoliday(3) = DateSerial(lngYear, 11, 29 - _
Weekday(DateSerial(lngYear, 11, 1), vbFriday))

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

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

'Easter
lngDay = (((255 - 11 * (lngYear Mod 19)) - 21) Mod 30) + 21

dteHoliday(5) = DateSerial(lngYear, 3, 1) + lngDay + _
(lngDay > 48) + 6 - ((lngYear + lngYear \ 4 + _
lngDay + (lngDay > 48) + 1) Mod 7)


'MLK Day - Third Monday of January
lngDay = 1
lngCount = 0
Do
If Weekday(DateSerial(lngYear, 1, lngDay)) = 2 Then
lngCount = lngCount + 1
End If
If lngCount = 3 Then
dteHoliday(6) = DateSerial(lngYear, 1, lngDay)
End If
Loop Until lngCount = 3


For lngCount = 0 To (dteEnd - dteStart)
dteCurr = (dteStart + lngCount)
If (Weekday(dteCurr) <> 1) And (Weekday(dteCurr) <> 7) Then
blnHol = False
For dteLoop = 0 To 6
If (dteHoliday(dteLoop) = dteCurr) Then blnHol = True
Next dteLoop
If blnHol = False Then lngTotal = lngTotal + 1
End If
Next lngCount

BusinessDays = lngTotal
Forms![frmTransactions].[CompletionTime].Value = BusinessDays

End Function

Open the code window, go to the line If Me.Status = "Closed" Then, and in the left margin, click your mouse. This will highlight the row with a maroon color, meaning the code will pause running at that point. Run your form as normal. When the program reaches that line, the code will pause execution and the code window will open.

From there, press F8 to step through the code, line by line. This way, you'll see exactly what is causing the bug/infinite loop. Once you figure it out, go back to the above line, and then click on the left margin again to remove the breakpoint.

Are your start and end dates in different years? I believe the version of that function I posted required your dates to be in the same year. I have an update version of the function inwhich your date spand can include multiple years I can send it to you if needed.

They are in different years, yes. I would appreciate the updated version, thanks.

Also, I'm not familiar with the NZ function mentioned above. How exactly does that work and would I simply replace If(IsNull()) with NZ()?

The Nz Function:

Nz(<FieldToCheck>, Value If Null)

Therefore, this:

If Not(IsNull(TextBoxA)) Then

Is This:

If Nz(TextBoxA,"")<>"" Then

The Nz function becomes more useful because you can automatically convert a NULL value to something more meaningful. The "Value If Null" can be anything, so in your Closed If/Then statement, you could write this:

If Me.Status = "Closed" Then
Me.DateCompleted.Value = Nz([DateCompleted],Date)
BusinessDays DateReceived, DateCompleted
End If

The above, in English, says, "If Status = Closed, then DateCompleted = Date if DateCompleted is Null. If DateCompleted not Null, then take what's in the DateCompleted field."

In other words, If your DateCompleted value contains something besides a null value, then it's used. If it is a null, then the "Value If Null" entry is used, which in this case is Date.

The Nz function will replace a null value with your choosen value. The updated function is below.

Public Function BusinessDays(dteStartDate As Date, dteEndDate As Date) 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

Thanks, guys. You've been very helpful. I've upped your rep points!

Upon further examination, I think my loop problem is occurring because I have the form checking for consistency too many times. For example, when the user exits the DateCompleted field, it checks to make sure a DateReceived has been entered. I think that when the Status change sub was entering or clearing dates it tripped itself up. I'm moving all the code to one final check before a save to see if that clears up the problem.

I've also gone back to the Select Case as that did not appear to be the source of the problem and it cleans up the code. I really like that NZ() thing! That also makes the code cleaner. :)

Here's what the new code looks like. I'll report back on whether or not the endless loop was a timing error.

Thanks again!
-CF

P.S. Is there a way in to have the result of NZ() be a message box? I can't seem to get that to work.


Private Sub Status_Change()
Dim X As Integer

Select Case Status
Case "Open"
If Not IsNull([DateCompleted]) Then
X = MsgBox("A completion date has already been entered for this transaction. If this entry has been made in error and you would like to reopen this transaction, please select 'OK'. If you are processing a new transaction, please select 'Cancel' and create a new transaction.", vbOKCancel, vbInformation)

If X = vbOK Then
Me.DateCompleted.Value = ""
Me.CompletionTime.Value = ""
End If
End If

Case "Closed"
Me.DateCompleted.Value = Nz([DateCompleted], Date)
BusinessDays DateReceived, DateCompleted

Case "More Info Requested"
If Not IsNull([DateCompleted]) Then
X = MsgBox("A completion date has already been entered for this transaction. If this entry has been made in error and you would like to reopen this transaction, please select 'OK'. If you are processing a new transaction, please select 'Cancel' and create a new transaction.", vbOKCancel + vbInformation)

If X = vbOK Then
Me.DateCompleted.Value = ""
Me.CompletionTime.Value = ""
End If
End If

Case "Dead"
Me.DateCompleted.Value = Nz([DateCompleted], Date)
BusinessDays DateReceived, DateCompleted
End Select
End Sub

If the name of your control is Status then you should know that the Change event occurs for *every* keystroke in the control. Normally you do validation in the BeforeUpdate event and propagate the value of the control in the AfterUpdate event of the control. These last two events occur only once for the update.

RuralGuy, the control is a combo limited to the list so I figured it was ok to run the check after each change. Is this not correct? My thinking is that if a user, for example, changes the status from Open to Closed, the system would automatically fill in the closed date as the current date, but I then wanted to give the user the chance to enter a different date before saving, as opposed to runnin the check at the last minute, entering the current date in the field, and then saving that to the table and closing the form. Am I misundderstanding how Access works?

I follow your suggestion to move it to the BeforeUpdate event, but what do you mean by propagate the value in the AfterUpdate event?

Thanks.

I would think your code belongs in the AfterUpdate event of the ComboBox.

Unless you take extraordinary steps, the current record is only saved when you change records or close the form. In either case, it will be *after* the AfterUpdate event of the ComboBox. If you key in Events to the Answer Wizard in Access Help (NOT VBA Help) there is a good explaination for the event model of Access.

Putting it in the AfterUpdate event works great. Thanks for the help! I started a thread for another validation question here (http://www.access-programmers.co.uk/forums/showthread.php?t=141627) that's related.

Glad to hear you got it sorted.