Solved Duplication of Message prompt in Change Event

BusyBeeBiker

New member
Local time
Today, 18:43
Joined
Jun 27, 2021
Messages
26
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.
 
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.
Code:
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
 
Last edited:
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.
Code:
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.

Code:
' 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
 
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
 
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.
 
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.
 

Users who are viewing this thread

Back
Top Bottom