Frozen Select Case

[ChronicFear]

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

 

[KeithG]

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?

 

[RuralGuy]

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.

 

[Moniker]

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.

 

[ChronicFear]

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

 

[Moniker]

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.

 

[KeithG]

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.

 

[ChronicFear]

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()?

 

[Moniker]

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.

 

[KeithG]

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

 

[ChronicFear]

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

 

[RuralGuy]

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.

 

[ChronicFear]

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.

 

[RuralGuy]

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

 

[RuralGuy]

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.

 

[ChronicFear]

Putting it in the AfterUpdate event works great. Thanks for the help! I started a thread for another validation question here that's related.

 

[RuralGuy]

Glad to hear you got it sorted.