Userform TabStop & TabIndex

M

mikeymay

Well-known Member
Joined
Jan 17, 2006
Messages
1,600
Office Version
  1. 365
Platform
  1. Windows
I have a UF that captures information such as name, address, tel number, etc via textboxes.

I have checks on some of the textboxes to ensure the correct format of entry is made. E.g. Mobile number - this checks for the correct prefix and the count of digits.

On the majority of the textbox_afterupdate code, the cursor moves to the next TabIndex but when a Msgbox pops up if an entry is invalid, the TabIndex doesn't work.

I have tried a work-around by using the .SetFocus command but this only works when that line executes, but on End Sub the desired control loses focus.

Code for the full UF is below
VBA Code: 
Option Explicit

Dim ctlControl As msforms.Control

Dim strEmail As String

Dim intValid As Integer

Dim boolClear As Boolean

Private Sub optI_Click()

If optI = True Then
   txtOrganisation = ""
   txtOrganisation.Enabled = False
   
   txtPosition = ""
   txtPosition.Enabled = False
   Else
   txtOrganisation.Enabled = True
   txtPosition.Enabled = True
End If

CheckClear
CheckAdd

cbTitle.SetFocus

End Sub

Private Sub optO_Click()

If optO = True Then
   txtOrganisation.Enabled = True
   txtPosition.Enabled = True
   Else
   txtOrganisation = ""
   txtOrganisation.Enabled = False
   
   txtPosition = ""
   txtPosition.Enabled = False
End If

CheckClear
CheckAdd

cbTitle.SetFocus

End Sub

Private Sub cbTitle_change()

If boolClear = True Then
   Exit Sub
   Else
End If

CheckClear
CheckAdd

txtFirstName.SetFocus

End Sub

Private Sub txtFirstName_afterupdate()

If boolClear = True Then
   Exit Sub
   Else
End If

CheckClear
CheckAdd

txtFirstName = Trim(WorksheetFunction.Proper(txtFirstName))

txtSurname.SetFocus

End Sub

Private Sub txtSurname_afterupdate()

If boolClear = True Then
   Exit Sub
   Else
End If

CheckClear
CheckAdd

txtSurname = Trim(WorksheetFunction.Proper(txtSurname))
   
If optI = True Then
   txtAddress.SetFocus
   Else
   txtOrganisation.SetFocus
End If

End Sub

Private Sub txtOrganisation_afterupdate()

If boolClear = True Then
   Exit Sub
   Else
End If

If Trim(txtOrganisation) = "" Then
   txtPosition = ""
   
   txtPosition.Enabled = False
   Else
   txtOrganisation = Trim(WorksheetFunction.Proper(txtOrganisation))
   
   txtPosition.Enabled = True
   
   txtPosition.SetFocus
End If

CheckClear
CheckAdd

End Sub

Private Sub txtPosition_afterupdate()

If boolClear = True Then
   Exit Sub
   Else
End If

CheckClear
CheckAdd

txtPosition = Trim(WorksheetFunction.Proper(txtPosition))

End Sub

Private Sub txtAddress_afterupdate()

If boolClear = True Then
   Exit Sub
   Else
End If

CheckClear
CheckAdd

txtAddress = Trim(WorksheetFunction.Proper(txtAddress))

End Sub

Private Sub txtPostCode_afterupdate()

If boolClear = True Then
   Exit Sub
   Else
End If

CheckClear
CheckAdd

txtPostCode = Trim(UCase(txtPostCode))

End Sub

Private Sub txtMobile_afterupdate()

If boolClear = True Then
   Exit Sub
   Else
End If

If Trim(txtMobile) = "" Then
   txtMobile = ""
   
   txtLandLine.SetFocus
   Else
   txtMobile = Replace(Trim(txtMobile), " ", "")
   
   If Left(txtMobile, 2) <> "07" Then
      MsgBox ("needs 07 prefix")
      
      txtMobile.SetFocus
      Else
      If Len(txtMobile) <> 11 Then
         MsgBox ("needs 11 digits")
         
         txtMobile.SetFocus
         Else
         txtLandLine.SetFocus
      End If
   End If
End If

txtMobile = Trim(txtMobile)

CheckClear
CheckAdd

End Sub

Private Sub txtLandLine_afterupdate()

If boolClear = True Then
   Exit Sub
   Else
End If

If IsNumeric(CLng(Trim(txtLandLine))) Then
   Else
   MsgBox ("contains letters")
   
   txtLandLine = Trim(txtLandLine)
   
   txtLandLine.SetFocus
End If

CheckClear
CheckAdd

txtLandLine = Trim(txtLandLine)

End Sub

Private Sub txtEmail1_afterupdate()

If boolClear = True Then
   Exit Sub
   Else
End If

If Trim(txtEmail1) = "" Then
   txtEmail1 = ""
   Else
   strEmail = Replace(Trim(txtEmail1), " ", "")
   
   CheckEmail
   
   If intValid = 0 Then
      MsgBox ("Invalid email address")
      
      txtEmail1.SetFocus
      Else
   End If
End If

'boolClear = False

CheckClear
CheckAdd

End Sub

Private Sub txtEmail2_afterupdate()

If boolClear = True Then
   Exit Sub
   Else
End If

'boolClear = True

If Trim(txtEmail2) = "" Then
   txtEmail2 = ""
   Else
   strEmail = Replace(Trim(txtEmail2), " ")
   
   CheckEmail
   
   If intValid = 0 Then
      MsgBox ("Invalid email address")
      
      txtEmail2.SetFocus
      Else
   End If
End If

CheckClear
CheckAdd

End Sub

Private Sub txtWebsite_afterupdate()

If boolClear = True Then
   Exit Sub
   Else
End If

CheckClear
CheckAdd

End Sub

Private Sub btnAdd_Click()

strTitle = cbTitle
strFirstName = txtFirstName
strSurname = txtSurname
strFullName = strSurname & ", " & strFirstName

If optI = True Then
   boolI = True
   boolO = False
   
   strOrganisation = ""
   strPosition = ""
   Else
   boolI = False
   boolO = True
   
   strOrganisation = txtOrganisation
   strPosition = txtPosition
End If

strAddress = txtAddress & Chr(10) & txtPostCode

strMobile = txtMobile

If txtLandLine = "" Then
   strLandLine = ""
   Else
   strLandLine = txtLandLine
End If

strEmail1 = txtEmail1

If txtEmail2 = "" Then
   strEmail2 = ""
   Else
   strEmail2 = txtEmail2
End If

If txtWebsite = "" Then
   strWebsite = ""
   Else
   strWebsite = txtWebsite
End If

frmPIAdd.Hide

End Sub

Private Sub btnClear_Click()

boolClear = True

optI = False
optO = False

cbTitle = ""
txtFirstName = ""
txtSurname = ""
txtSurname = ""

If txtOrganisation.Enabled = True Then
   txtOrganisation = ""
   
   txtOrganisation.Enabled = False
   Else
End If

If txtPosition.Enabled = True Then
   txtPosition = ""
   
   txtPosition.Enabled = False
   Else
End If

txtAddress = ""
txtPostCode = ""
txtMobile = ""
txtLandLine = ""
txtEmail1 = ""
txtEmail2 = ""
txtWebsite = ""

boolClear = False

btnClear.Enabled = False

cbTitle.SetFocus

End Sub

Private Sub btnCancel_Click()

boolCancel = True

frmPIAdd.Hide

End Sub

Private Sub CheckEmail()

Dim reExp As RegExp

Dim mcMatch As MatchCollection

Set reExp = New RegExp

With reExp
   .Pattern = "^[a-z0-9_.-]+@[a-z0-9.-]{2,}\.[a-z]{2,4}$"
   .IgnoreCase = True
   .Global = False
End With

Set mcMatch = reExp.Execute(strEmail)

intValid = (mcMatch.Count = 1)

Set mcMatch = Nothing
Set reExp = Nothing

End Sub

Private Sub CheckAdd()

If optI = False And optO = False Then
   btnAdd.Enabled = False
   
   Exit Sub
   Else
End If

If optI = True Then
   For Each ctlControl In Me.Controls
      If TypeName(ctlControl) = "TextBox" Or TypeName(ctlControl) = "ComboBox" Then
         If ctlControl.Name = "txtOrganisation" Or _
            ctlControl.Name = "txtPosition" Or _
            ctlControl.Name = "txtLandLine" Or _
            ctlControl.Name = "txtEmail2" Or _
            ctlControl.Name = "txtWebsite" Then
               
            Else
            If Trim(ctlControl.Text) = "" Then
               btnAdd.Enabled = False
               
               Exit For
               Else
               btnAdd.Enabled = True
            End If
         End If
         Else
      End If
   Next
   Else
   For Each ctlControl In Me.Controls
      If TypeName(ctlControl) = "TextBox" Or TypeName(ctlControl) = "ComboBox" Then
         If ctlControl.Name = "txtLandLine" Or _
            ctlControl.Name = "txtEmail2" Or _
            ctlControl.Name = "txtWebsite" Then
               
            Else
            If Trim(ctlControl.Text) = "" Then
               btnAdd.Enabled = False
               
               Exit For
               Else
               btnAdd.Enabled = True
            End If
         End If
         Else
      End If
   Next
End If

End Sub

Private Sub CheckClear()

Application.ScreenUpdating = False
Application.EnableEvents = True

For Each ctlControl In Me.Controls
   Select Case TypeName(ctlControl)
      Case "TextBox", "ComboBox"
         If ctlControl.Value <> "" Then
            btnClear.Enabled = True
            
            Exit For
            Else
         End If
      
      Case "OptionButton"
         If ctlControl.Value = True Then
            btnClear.Enabled = True
            
            Exit For
            Else
         End If
      
      Case Else
      
   End Select
   
   btnClear.Enabled = False
Next

Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub
 

Excel Facts

How to change case of text in Excel?
Use =UPPER() for upper case, =LOWER() for lower case, and =PROPER() for proper case. PROPER won't capitalize second c in Mccartney
Sort by date Sort by votes
Hi,
try using the Exit event of the control which has the Cancel parameter

VBA Code: 
Private Sub txtEmail2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    If boolClear = True Then Exit Sub

    If Trim(txtEmail2) = "" Then
       txtEmail2 = ""
       Else
       strEmail = Replace(Trim(txtEmail2.Text), " ", "")
       Cancel = Not CheckEmail(strEmail)
       If Cancel Then
          MsgBox "Invalid email address", 48, "Invalid Entry"
          Exit Sub
       End If
    End If
    
    CheckClear
    CheckAdd
End Sub

Also, you could make your CheckEmail code a Function to return a boolean value

VBA Code: 
Function CheckEmail(ByVal EmailAddress As String) As Boolean
    Dim reExp As RegExp
    
    Dim mcMatch As MatchCollection
    
    Set reExp = New RegExp
    
    With reExp
       .Pattern = "^[a-z0-9_.-]+@[a-z0-9.-]{2,}\.[a-z]{2,4}$"
       .IgnoreCase = True
       .Global = False
    End With
    
    Set mcMatch = reExp.Execute(EmailAddress)
    
    CheckEmail = (mcMatch.Count = 1)
    
    Set mcMatch = Nothing
    Set reExp = Nothing

End Function

Textbox Exit event uses suggested Function

Dave
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question
textBox AfterUpdate firing unexpectedly
Replies
3
Views
135
RoryA
RoryA
M
  • Question
Add in VBA Code to check zip code against pre-determined list
Replies
0
Views
148
mikefisher
M
P
  • Question
Check two different statements on the Exit Routine
Replies
3
Views
224
Micron
M
P
  • Solved
VBYes/No Responses
Replies
5
Views
337
Pacman52
P
M
  • Solved
TabIndex Override
Replies
2
Views
629
mikeymay
M

Forum statistics

Threads
1,214,786
Messages
6,121,553
Members
449,038
Latest member
Guest1337

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top