Solved Duplication of Message prompt in Change Event (1 Viewer)

[BusyBeeBiker]

Can anybody throw any light onto the thread I have posted in VBA Express.
Duplication of Message Prompt (vbaexpress.com)

I think the logic in my code flies, but can't figure out the event behaviour that is occurring in the Change event when MsgBox command fires.

Need a another pair of eyes on this one.

 

[CJ_London]

try stepping through your code and see where it goes

 

[arnelgp]

note i only add bolHandled to the first 2 code where you switch tab to 0.
you need to do the same with the rest.

Option Compare Database
Option Explicit

Dim bolHandled As Boolean

Private Sub TabCtPersonnel_Change()

If bolHandled Then
    bolHandled = False
    Exit Sub
End If

If glbHandleErrors Then On Error GoTo ErrHandler ' Set Error Handling


    Dim dbs As DAO.Database ' Dimension Database
    Dim rs As DAO.Recordset ' Dimesion Recordset
    Dim strSQL As String ' Dimension SQL Statement
    Static Counter As Integer
   
    Set dbs = CurrentDb ' Initialise a reference to the current database


    strSQL = "SELECT tblStatus.pkStatusID, tblStatus.fkPersonID FROM tblStatus " _
           & "WHERE NZ(tblStatus.fkPersonID,0) = " & Nz([Forms]![frmPersonnel]![pkPersonID], 0) & ";"
           
    Set rs = dbs.OpenRecordset(strSQL) ' Initialise Recordset to determine if Available.


' 1. CHECKS TO SEE IF CONTACT DETAILS HAVE BEEN COMPLETED, PRIMARILY SURNAME FIELD.
    If IsNull(Me.txtSurname) Then
            bolHandled = True
            MsgBox "Complete Surname in Contact Tab before accessing other Tabs"
            Me.TabCtPersonnel = 0 ' Moves to Contact Tab
            GoTo ExitHere:
     End If


' 2. CHECKS TO SEE IF STATUS INFO SUB FORM HAS BEEN FILLED OUT CORRECTLY.
    If rs.RecordCount = 0 Then
        bolHandled = True
         MsgBox "Complete Status and Start Date fields of Status Info Sub Form to Access Other Tabs"
        Me.TabCtPersonnel = 0 ' Moves to Contact Tab
        Me!frmStatusSubForm.Form.txtStatusDesc.SetFocus ' Returns focus to first field of Status Info Sub Form
    Else
        ' Checks to see that BOTH Type and Start Date fields are complete.
        If IsNull(Me!frmStatusSubForm.Form.txtStatusDesc) Or IsNull(Me!frmStatusSubForm.Form.dtmSStart) Then
            bolHandled = True
            MsgBox "Complete Status and Start Date fields of Status Info Sub Form to Access Other Tabs"
            Me.TabCtPersonnel = 0 ' Moves to Contact Tab
            If IsNull(Me!frmStatusSubForm.Form.txtStatusDesc) Then
                Me!frmStatusSubForm.Form.txtStatusDesc.SetFocus
            Else
                Me!frmStatusSubForm.Form.dtmSStart.SetFocus
            End If
            GoTo ExitHere:
        End If
     End If

' 3. CHECKS TO SEE WHICH TABS USER HAS ACCESS TO DEPENDENT ON SECURITY LEVEL AND TYPE OF PERSON STAFF, LEARNER, ETC.
    Select Case Me.TabCtPersonnel.Value
      Case Me.pgContact.PageIndex ' Contact Tab


      Case Me.pgPersonal.PageIndex ' Personal Tab


      Case Me.pgLearner1.PageIndex ' Learner Tab
        If Not Forms("frmPersonnel").Form("frmStatusSubForm").Form("txtStatusDesc") Like "Learner" Then
            Forms!frmPersonnel.TabCtPersonnel = 0 ' Moves to Contact Tab
        End If


      Case Me.pgStaff.PageIndex ' Staff Tab
        If Not Forms("frmPersonnel").Form("frmStatusSubForm").Form("txtStatusDesc") Like "Staff*" Then
            Forms!frmPersonnel.TabCtPersonnel = 0 ' Moves to Contact Tab
        End If
       
      Case Me.pgVolunteer.PageIndex ' Volunteer Tab
        If Not Forms("frmPersonnel").Form("frmStatusSubForm").Form("txtStatusDesc") Like "Volunteer" Then
            Forms!frmPersonnel.TabCtPersonnel = 0 ' Moves to Contact Tab
        End If
       
      Case Me.pgHumanResource.PageIndex ' Human Resources Tab
        ' Only Allows Security Level of >8 AND doesn't allow Person to see own record.
        If Forms!frmLoginScreen!numSecurityLevel < 8 Or Me!pkPersonID = Forms!frmLoginScreen!fkID Then
            Forms!frmPersonnel.TabCtPersonnel = 0 ' Moves to Contact Tab
        Else
        ' Only show record if Persons Login Security Level is < Person Logged in.
            strSQL = "SELECT tblPerson.pkPersonID, tblLogin.fkID, tblLogin.numSecurityLevel " _
                   & "FROM tblPerson LEFT JOIN tblLogin ON tblPerson.pkPersonID = tblLogin.fkID " _
                   & "WHERE IIF(IsNull(tblLogin.numSecurityLevel),0,tblLogin.numSecurityLevel)<" & Forms!frmLoginScreen!numSecurityLevel & " " _
                   & "AND tblLogin.fkID=" & Forms!frmPersonnel!pkPersonID & ";"
                   
            Set rs = dbs.OpenRecordset(strSQL) ' Initialise Recordset to determine if Available.
           
            rs.MoveFirst
           
'           Do While Not rs.BOF And Not rs.EOF
                If rs.NoMatch Then
                    Forms!frmPersonnel.TabCtPersonnel = 0 ' Moves to Contact Tab
                End If
'            Loop
       End If
               
      Case Me.pgLearner.PageIndex ' SnapShot Tab
        If Not Forms("frmPersonnel").Form("frmStatusSubForm").Form("txtStatusDesc") Like "Learner" Then
            Forms!frmPersonnel.TabCtPersonnel = 0 ' Moves to Contact Tab
        End If
       
      Case Me.pgAttendance.PageIndex ' Time Tab


      Case Me.pgAdmin.PageIndex ' Admin Tab


    End Select



ExitHere:  ' Any Error Clean Up Code
   rs.Close
   dbs.Close
   Set rs = Nothing
   Set dbs = Nothing
   Err.Clear
   Exit Sub

ErrHandler: ' ERROR HANDLING ROUTINE.
   If Err.Number <> 0 Then
       Call LogError(Err.Number, Err.Description, Forms!frmLoginScreen!fkID, Environ("UserName"), Environ("ComputerName"), "", glbHandleErrors)
      Resume ExitHere
   End If


End Sub

 

[BusyBeeBiker]

note i only add bolHandled to the first 2 code where you switch tab to 0.
you need to do the same with the rest.

Option Compare Database
Option Explicit

Dim bolHandled As Boolean

Private Sub TabCtPersonnel_Change()

If bolHandled Then
    bolHandled = False
    Exit Sub
End If

If glbHandleErrors Then On Error GoTo ErrHandler ' Set Error Handling


    Dim dbs As DAO.Database ' Dimension Database
    Dim rs As DAO.Recordset ' Dimesion Recordset
    Dim strSQL As String ' Dimension SQL Statement
    Static Counter As Integer
  
    Set dbs = CurrentDb ' Initialise a reference to the current database


    strSQL = "SELECT tblStatus.pkStatusID, tblStatus.fkPersonID FROM tblStatus " _
           & "WHERE NZ(tblStatus.fkPersonID,0) = " & Nz([Forms]![frmPersonnel]![pkPersonID], 0) & ";"
          
    Set rs = dbs.OpenRecordset(strSQL) ' Initialise Recordset to determine if Available.


' 1. CHECKS TO SEE IF CONTACT DETAILS HAVE BEEN COMPLETED, PRIMARILY SURNAME FIELD.
    If IsNull(Me.txtSurname) Then
            bolHandled = True
            MsgBox "Complete Surname in Contact Tab before accessing other Tabs"
            Me.TabCtPersonnel = 0 ' Moves to Contact Tab
            GoTo ExitHere:
     End If


' 2. CHECKS TO SEE IF STATUS INFO SUB FORM HAS BEEN FILLED OUT CORRECTLY.
    If rs.RecordCount = 0 Then
        bolHandled = True
         MsgBox "Complete Status and Start Date fields of Status Info Sub Form to Access Other Tabs"
        Me.TabCtPersonnel = 0 ' Moves to Contact Tab
        Me!frmStatusSubForm.Form.txtStatusDesc.SetFocus ' Returns focus to first field of Status Info Sub Form
    Else
        ' Checks to see that BOTH Type and Start Date fields are complete.
        If IsNull(Me!frmStatusSubForm.Form.txtStatusDesc) Or IsNull(Me!frmStatusSubForm.Form.dtmSStart) Then
            bolHandled = True
            MsgBox "Complete Status and Start Date fields of Status Info Sub Form to Access Other Tabs"
            Me.TabCtPersonnel = 0 ' Moves to Contact Tab
            If IsNull(Me!frmStatusSubForm.Form.txtStatusDesc) Then
                Me!frmStatusSubForm.Form.txtStatusDesc.SetFocus
            Else
                Me!frmStatusSubForm.Form.dtmSStart.SetFocus
            End If
            GoTo ExitHere:
        End If
     End If

' 3. CHECKS TO SEE WHICH TABS USER HAS ACCESS TO DEPENDENT ON SECURITY LEVEL AND TYPE OF PERSON STAFF, LEARNER, ETC.
    Select Case Me.TabCtPersonnel.Value
      Case Me.pgContact.PageIndex ' Contact Tab


      Case Me.pgPersonal.PageIndex ' Personal Tab


      Case Me.pgLearner1.PageIndex ' Learner Tab
        If Not Forms("frmPersonnel").Form("frmStatusSubForm").Form("txtStatusDesc") Like "Learner" Then
            Forms!frmPersonnel.TabCtPersonnel = 0 ' Moves to Contact Tab
        End If


      Case Me.pgStaff.PageIndex ' Staff Tab
        If Not Forms("frmPersonnel").Form("frmStatusSubForm").Form("txtStatusDesc") Like "Staff*" Then
            Forms!frmPersonnel.TabCtPersonnel = 0 ' Moves to Contact Tab
        End If
      
      Case Me.pgVolunteer.PageIndex ' Volunteer Tab
        If Not Forms("frmPersonnel").Form("frmStatusSubForm").Form("txtStatusDesc") Like "Volunteer" Then
            Forms!frmPersonnel.TabCtPersonnel = 0 ' Moves to Contact Tab
        End If
      
      Case Me.pgHumanResource.PageIndex ' Human Resources Tab
        ' Only Allows Security Level of >8 AND doesn't allow Person to see own record.
        If Forms!frmLoginScreen!numSecurityLevel < 8 Or Me!pkPersonID = Forms!frmLoginScreen!fkID Then
            Forms!frmPersonnel.TabCtPersonnel = 0 ' Moves to Contact Tab
        Else
        ' Only show record if Persons Login Security Level is < Person Logged in.
            strSQL = "SELECT tblPerson.pkPersonID, tblLogin.fkID, tblLogin.numSecurityLevel " _
                   & "FROM tblPerson LEFT JOIN tblLogin ON tblPerson.pkPersonID = tblLogin.fkID " _
                   & "WHERE IIF(IsNull(tblLogin.numSecurityLevel),0,tblLogin.numSecurityLevel)<" & Forms!frmLoginScreen!numSecurityLevel & " " _
                   & "AND tblLogin.fkID=" & Forms!frmPersonnel!pkPersonID & ";"
                  
            Set rs = dbs.OpenRecordset(strSQL) ' Initialise Recordset to determine if Available.
          
            rs.MoveFirst
          
'           Do While Not rs.BOF And Not rs.EOF
                If rs.NoMatch Then
                    Forms!frmPersonnel.TabCtPersonnel = 0 ' Moves to Contact Tab
                End If
'            Loop
       End If
              
      Case Me.pgLearner.PageIndex ' SnapShot Tab
        If Not Forms("frmPersonnel").Form("frmStatusSubForm").Form("txtStatusDesc") Like "Learner" Then
            Forms!frmPersonnel.TabCtPersonnel = 0 ' Moves to Contact Tab
        End If
      
      Case Me.pgAttendance.PageIndex ' Time Tab


      Case Me.pgAdmin.PageIndex ' Admin Tab


    End Select



ExitHere:  ' Any Error Clean Up Code
   rs.Close
   dbs.Close
   Set rs = Nothing
   Set dbs = Nothing
   Err.Clear
   Exit Sub

ErrHandler: ' ERROR HANDLING ROUTINE.
   If Err.Number <> 0 Then
       Call LogError(Err.Number, Err.Description, Forms!frmLoginScreen!fkID, Environ("UserName"), Environ("ComputerName"), "", glbHandleErrors)
      Resume ExitHere
   End If


End Sub

Many thanks for that it works a charm, did try something similar but didn't add Dim bolHandled As Boolean in the declaration section to make it available through-out the Form Module.

Two quick supplemental questions:
1. Am I better putting the variable bolHandled in the declaration section of a Standard Module allowing it access everywhere?
2. In the code snippet below I am trying to return focus (highlighted red) to a field in a sub form but it keeps sending me back to a field in the mainform.

' 2. CHECKS TO SEE IF STATUS INFO SUB FORM HAS BEEN FILLED OUT CORRECTLY.
    If rs.RecordCount = 0 Then
        binHandled = True
        MsgBox "Complete Status and Start Date fields of Status Info Sub Form to Access Other Tabs"
        Me.TabCtPersonnel = 0 ' Moves to Contact Tab
        Me!frmStatusSubForm.Form!txtStatusDesc.SetFocus ' Returns focus to first field of Status Info Sub Form

 

[arnelgp]

i think it is better to leave the variable in the Form.

setfocus on the subform, then on the textbox:


...
...
If rs.RecordCount = 0 Then
binHandled = True
MsgBox "Complete Status and Start Date fields of Status Info Sub Form to Access Other Tabs"
Me.TabCtPersonnel = 0 ' Moves to Contact Tab
Me!frmStatusSubForm.SetFocus
Me!frmStatusSubForm.Form!txtStatusDesc.SetFocus ' Returns focus to first field of Status Info Sub Form

 

[BusyBeeBiker]

i think it is better to leave the variable in the Form.

setfocus on the subform, then on the textbox:


...
...
If rs.RecordCount = 0 Then
binHandled = True
MsgBox "Complete Status and Start Date fields of Status Info Sub Form to Access Other Tabs"
Me.TabCtPersonnel = 0 ' Moves to Contact Tab
Me!frmStatusSubForm.SetFocus
Me!frmStatusSubForm.Form!txtStatusDesc.SetFocus ' Returns focus to first field of Status Info Sub Form

That's great. Many thanks for your time and knowledge.

 

[Pat Hartman]

The change event fires once fore each character typed into the control so unless you actually want to validate one character at a time, this is not a good event to use for validation.