Userform fails to set focus on textbox

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
5,736
Office Version
  1. 2007
Platform
  1. Windows
Hi.
I am using the code shown below.
On my userform i have various textboxes / comboboxes of which all work well but this one below has the issue.

Textbox2 must have 17 characters before the form will transfer to worksheet.

If the above is less than 17 i should see a message box advising the user.
Once ok i click TextBox2 should have set focus applied so the user can correct the value so its 17

What happens is i see the message box advising about must be 17 characters etc BUT then when i click ok i am not taken to Textbox2 BUT the line of code below is shown in yellow.
The form has now lost all the info & needs to be completed again.



Rich (BB code):
Private Sub CommandButton1_Click()
      If OptionButton1.Value = True And OptionButton7.Value = False And OptionButton8.Value = False _
      And OptionButton9.Value = False And OptionButton10.Value = False And OptionButton11.Value = False Then
     
        MsgBox "You Must Select A Lead Type", vbCritical, "Lead Type Selection Error Message"
 Else
  If Len(Me.TextBox2.Value) = 17 Then
    Dim i As Long, x As Long
    Dim ControlsArr(1 To 8) As Variant, ns As Variant
    
    Application.ScreenUpdating = False
    For i = 1 To 8
      ControlsArr(i) = Controls(IIf(i > 2, "ComboBox", "TextBox") & i).Value
    Next i
    
    With ThisWorkbook.Worksheets("MCLIST")
      .Range("A8").EntireRow.Insert Shift:=xlDown
      .Range("A8:K8").Borders.Weight = xlThin
      .Cells(8, 1).Resize(, UBound(ControlsArr)).Value = ControlsArr
      
      If ComboBox3.Value = "HONDA" Then
      .Cells(8, 2).Characters(Start:=10, Length:=1).Font.Color = vbRed
      .Cells(8, 9).Font.Color = vbRed
      Else
      .Cells(8, 2).Characters(Start:=10, Length:=1).Font.Color = vbBlack
      .Cells(8, 9).Font.Color = vbBlack
      End If
      
      If OptionButton1.Value Then .Cells(8, 10).Value = "YES"
      If OptionButton2.Value Then .Cells(8, 10).Value = "NO"
      If OptionButton2.Value Then .Cells(8, 11).Value = "N/A"
      If OptionButton7.Value Then .Cells(8, 11).Value = "BUNDLE"
      If OptionButton8.Value Then .Cells(8, 11).Value = "GREY"
      If OptionButton9.Value Then .Cells(8, 11).Value = "RED"
      If OptionButton10.Value Then .Cells(8, 11).Value = "BLACK"
      If OptionButton11.Value Then .Cells(8, 11).Value = "CLEAR"
      
      If ComboBox3.Value = "HONDA" Then
      ns = Array("X", "Y", "1", "2", "3", "4", "5", "6", "7", "8", "9", "A", "B", "C", _
                 "D", "E", "F", "G", "H", "J", "K", "L", "M", "N", "P", "R", "S")
      For i = 0 To UBound(ns)
        If Mid(Range("B8").Value, 10, 1) = ns(i) Then
          Range("I8").Value = "" & 2000 + i
          Exit For
        End If
      Next
      End If
      
      Application.EnableEvents = False
      If .AutoFilterMode Then .AutoFilterMode = False
      x = .Cells(.Rows.Count, 1).End(xlUp).Row
      .Range("A7:K" & x).Sort Key1:=.Range("A8"), Order1:=xlAscending, Header:=xlGuess
      .Range("A:A").Find(TextBox1.Value, , xlValues, xlWhole).Select
      Application.Goto Selection, True
    End With
    ActiveWorkbook.Save
    MsgBox "DATABASE HAS NOW BEEN UPDATED", vbInformation, "SUCCESSFUL MESSAGE"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Unload McListForm
  Else
    MsgBox "VIN MUST BE 17 CHARACTERS" & vbCr & vbCr & "DATABASE WAS NOT UPDATED", vbCritical, "MCLIST TRANSFER"
    TextBox2.SetFocus
  End If
  End If
      If Me.ComboBox3.Value = "SUZUKI" Then
       MsgBox "DONT FORGET TO ADD YEAR", vbInformation, "MOTORCYCLE YEAR MESSAGE"
    ElseIf Me.ComboBox3.Value = "YAMAHA" Then
       MsgBox "DONT FORGET TO ADD YEAR", vbInformation, "MOTORCYCLE YEAR MESSAGE"
    ElseIf Me.ComboBox3.Value = "KAWASAKI" Then
       MsgBox "DONT FORGET TO ADD YEAR", vbInformation, "MOTORCYCLE YEAR MESSAGE"
    End If
    Range("A:A").Find(TextBox1.Value, , xlValues, xlWhole).Offset(, 8).Select
End Sub
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
A textbox event would be better to enforce that requirement prior to getting to the command button. Try the below out.

VBA Code:
Private Sub TextBox2_BeforeUpdate(Cancel As Integer)
If Not Len(Me.TextBox2.Value) = 17 Then
          MsgBox "VIN MUST BE 17 CHARACTERS"                   & vbCr & vbCr & "DATABASE WAS NOT       UPDATED", vbCritical, "MCLIST TRANSFER"
    TextBox2.SetFocus
     Exit Sub
End if

End Sub
 
Upvote 0
When i try that i get this error straight away
 

Attachments

  • 4901.jpg
    4901.jpg
    30.7 KB · Views: 13
Upvote 0
Sorry about that. Try an exit event using cancel if there's not 17 digits entered. Cancel will stop any tab move to another textbox or anywhere else outside textbox2.

VBA Code:
Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)

'Ignore blanks
If Me.TextBox2.Value = vbNullString Then Exit Sub

'Will not allow user to move forward unless 17 digits are entered or field is blank
If Not Len(Me.TextBox2.Value) = 17 Then
    MsgBox "VIN MUST BE 17 CHARACTERS" & vbCr & vbCr & "DATABASE WAS NOT " & _
        "UPDATED", vbCritical, "MCLIST TRANSFER"
    Cancel = True
    Exit Sub
End If
End Sub
 
Upvote 0
That did it thanks.
So now i need to remove the redundant code from original file.
So do i need to delete this part in red below ?

Thanks

Rich (BB code):
Private Sub CommandButton1_Click()
      If OptionButton1.Value = True And OptionButton7.Value = False And OptionButton8.Value = False _
      And OptionButton9.Value = False And OptionButton10.Value = False And OptionButton11.Value = False Then
     
        MsgBox "You Must Select A Lead Type", vbCritical, "Lead Type Selection Error Message"
 Else
  If Len(Me.TextBox2.Value) = 17 Then
    Dim i As Long, x As Long
    Dim ControlsArr(1 To 8) As Variant, ns As Variant
    
    Application.ScreenUpdating = False
    For i = 1 To 8
      ControlsArr(i) = Controls(IIf(i > 2, "ComboBox", "TextBox") & i).Value
    Next i
    
    With ThisWorkbook.Worksheets("MCLIST")
 
Upvote 0
I think this would be what you'd need to remove the 17 digit check from the commandbutton event.

VBA Code:
Private Sub CommandButton1_Click()

If OptionButton1.Value = True And OptionButton7.Value = False And OptionButton8.Value = False _
      And OptionButton9.Value = False And OptionButton10.Value = False And OptionButton11.Value = False Then
     
    MsgBox "You Must Select A Lead Type", vbCritical, "Lead Type Selection Error Message"
Else
    'removed len count for textbox2 from here
    Dim i As Long, x As Long
    Dim ControlsArr(1 To 8) As Variant, ns As Variant
    
    Application.ScreenUpdating = False
    For i = 1 To 8
      ControlsArr(i) = Controls(IIf(i > 2, "ComboBox", "TextBox") & i).Value
    Next i
    
    With ThisWorkbook.Worksheets("MCLIST")
        .Range("A8").EntireRow.Insert Shift:=xlDown
        .Range("A8:K8").Borders.Weight = xlThin
        .Cells(8, 1).Resize(, UBound(ControlsArr)).Value = ControlsArr
        
        If ComboBox3.Value = "HONDA" Then
          .Cells(8, 2).Characters(Start:=10, Length:=1).Font.Color = vbRed
          .Cells(8, 9).Font.Color = vbRed
        Else
          .Cells(8, 2).Characters(Start:=10, Length:=1).Font.Color = vbBlack
          .Cells(8, 9).Font.Color = vbBlack
        End If
        
        If OptionButton1.Value Then .Cells(8, 10).Value = "YES"
        If OptionButton2.Value Then .Cells(8, 10).Value = "NO"
        If OptionButton2.Value Then .Cells(8, 11).Value = "N/A"
        If OptionButton7.Value Then .Cells(8, 11).Value = "BUNDLE"
        If OptionButton8.Value Then .Cells(8, 11).Value = "GREY"
        If OptionButton9.Value Then .Cells(8, 11).Value = "RED"
        If OptionButton10.Value Then .Cells(8, 11).Value = "BLACK"
        If OptionButton11.Value Then .Cells(8, 11).Value = "CLEAR"
        
        If ComboBox3.Value = "HONDA" Then
          ns = Array("X", "Y", "1", "2", "3", "4", "5", "6", "7", "8", "9", "A", "B", "C", _
                     "D", "E", "F", "G", "H", "J", "K", "L", "M", "N", "P", "R", "S")
          For i = 0 To UBound(ns)
            If Mid(Range("B8").Value, 10, 1) = ns(i) Then
              Range("I8").Value = "" & 2000 + i
              Exit For
            End If
          Next
        End If
        
        Application.EnableEvents = False
        If .AutoFilterMode Then .AutoFilterMode = False
        x = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Range("A7:K" & x).Sort Key1:=.Range("A8"), Order1:=xlAscending, Header:=xlGuess
        .Range("A:A").Find(TextBox1.Value, , xlValues, xlWhole).Select
        Application.Goto Selection, True
    End With
    
    ActiveWorkbook.Save
    MsgBox "DATABASE HAS NOW BEEN UPDATED", vbInformation, "SUCCESSFUL MESSAGE"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Unload McListForm

    'removed IF Else for textbox2 len count here

End If
      If Me.ComboBox3.Value = "SUZUKI" Then
       MsgBox "DONT FORGET TO ADD YEAR", vbInformation, "MOTORCYCLE YEAR MESSAGE"
    ElseIf Me.ComboBox3.Value = "YAMAHA" Then
       MsgBox "DONT FORGET TO ADD YEAR", vbInformation, "MOTORCYCLE YEAR MESSAGE"
    ElseIf Me.ComboBox3.Value = "KAWASAKI" Then
       MsgBox "DONT FORGET TO ADD YEAR", vbInformation, "MOTORCYCLE YEAR MESSAGE"
    End If
    Range("A:A").Find(TextBox1.Value, , xlValues, xlWhole).Offset(, 8).Select
End Sub
 
Upvote 0

Forum statistics

Threads
1,223,893
Messages
6,175,240
Members
452,621
Latest member
Laura_PinksBTHFT

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