Userform Textbox SetFocus - No Cursor Displayed

Ark68

Well-known Member
Joined
Mar 23, 2004
Messages
4,616
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
I have this piece of code that checks the appropriateness of the value entered by the user in a userform textbox. It checks on whether a time value had been entered and happens things when a non time entry is made.

Code:
    If IsDate(Me.tb_s1_lwr.Value) Then
        ' enter code here for a properly provided time
    Else
        MsgBox "Please enter time as h:mm using 24 hour clock.", vbExclamation, "INVALID TIME ENTRY"
        'reset textbox to default
        Me.tb_s1_lwr.Value = ""
        tb_s1_lwr.BackColor = RGB(206, 234, 232)
        tb_s1_lwr.SetFocus
        mbevents = True
        Exit Sub
    End If

This woks for the better part except for one slight annoyance. I am trying to get the cursor to show up in the textbox tb_s1_lwr. The SetFocus command doesn't appear to be doing that for me.
 
Wonderful solution Jaafar! Thank you for sharing. It has made my application so much easier for our users to use.
 
Upvote 0

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.
Please, Jaafar, have a look at this common piece of code in a standard module in my worksheet. This code is activated by one of eight userform textbox (tb_s#_lwr, where # is 1-8) exit events. Frmservice is the userform from which the code is triggered from, and index is equal to 1-8, aka the # in the textbox name.

When index = 1, and the user enters a value in tb_s1_lwr and tabs out, your solution works flawlessly and sends focus to textbox tb_s1_upr with the cursor blinking away as needed.
However, the same cannot be said when index = 2. After the user enters a value in tb_s2_lwr, and tabs out, the focus goes to another control in my userform, not tb_s2_upr as one would expect, or hope. Can anyone explain why the behaviour is different although the same code is being used? Could the tab ordering of the fields play a roll in this?

Code:
Sub tb_lower(ByVal frmservice As Object, index As Integer)
    Stop
    Dim svc_start As Double
    If Not mbevents Then Exit Sub
    mbevents = False
    
    With frmservice
        With .Controls("tb_s" & index & "_lwr")
            If IsDate(.Value) Then
                .Value = Format(.Value, "H:MMA/P")
                .BackColor = RGB(255, 255, 255) 'white
            'is time within booking range
                svc_start = TimeValue(.Value)
                slwr_time = bkg_date + svc_start
                If slwr_time <= bkg_dst Or slwr_time >= bkg_det Then
                    MsgBox "The service time entered is outside the booking time.", vbExclamation, "INVALID TIME ENTRY"
                    .Value = ""
                    .BackColor = RGB(206, 234, 232) 'entry blue
                    Cancel = True 'Me.tb_s1_lwr.SetFocus
                    mbevents = True
                    Exit Sub
                End If
            Else
                If .Value = "" Then
                    mbevents = True
                    Exit Sub
                End If
                MsgBox "Please enter time as h:mm using 24 hour clock.", vbExclamation, "INVALID TIME ENTRY"
                .Value = ""
                .BackColor = RGB(206, 234, 232)
                Cancel = True
                mbevents = True
                Exit Sub
            End If
            ForceFocus frmservice.Controls("tb_s" & index & "_lwr")
            '.SetFocus
        End With
        .Controls("lbl_s" & index & "_1").BackColor = RGB(0, 128, 128)
        .Controls("tb_s" & index & "_upr").Enabled = True
        .Controls("tb_s" & index & "_upr").BackColor = RGB(206, 234, 232)
        ForceFocus .Controls("tb_s" & index & "_upr")
        '.Controls("tb_s" & index & "_upr").SetFocus
        .Controls("lbl_s" & index & "_2").Enabled = True
    End With
    mbevents = True
End Sub
 
Upvote 0
Not quite sure what the problem is. I don't think it has anything to do with the solution Jaafar provided. What I am finding is tabbing out of the previous control (tb_s2_lwr) does not trigger its exit code (unlike doing the same with tb_s1_lwr). Tabbing out simply send focus to another locked control in the userform. For me be able to enter data into tb_s2_upr, I have to click on it (unlike what I have to do to get to tb_s1_upr).

I don't know why I can trigger the event with a tab out in service 1, but using the same common code, I can't in service two. I have to click anywhere outside of tb_s2_lwr for it's exit code to trigger.

Any solution?
 
Upvote 0
Is it possible that the text box in question is in a form. And happens to be the last control in that Frame's tab order? Its a known but that in that situation, tabbing out of the textbox won't fire the Exit event.
 
Upvote 0
Hi Mikerickson. Thank you for that thought. This textbox is within a frame (frm_s2) and is one eight controls within it. It's number 3 in the tab order preceded by a couple checkboxes. It's basically a copy of service frame 1 (frm_s1) except the control names are appropriate for the service to allow mutual code to be run rather than each control being rewritten. As mentioned, I don't have this issue in the service frame 1 controls.

Interestingly, from tb_s2_upr (the one I have to click in to get tb_s2_lwr to trigger, I am able to tab out of to the next control. Its only tabbing between tb_s2_lwr and tb_s2_upr that isn't working.

This has become a significant hurdle in my project. If I can figure out how I can get my form to work independent of the rest of the project, I'd like to share it.
 
Upvote 0
I'm attached a link to access the files for this form if anyone wants import to have a peek at the whole messy thing. Unfortunately, it can't be run without errors due to supporting data needed from the worksheets and external files. It might help diagnose the problem to see how the whole form interacts with the user.

Based on mikerickson's comment, I did some Googling and it's evident that some people having been having similar problems with textbox.exit events from within a frame. I find it odd though I don't have that issue with the controls in the 1st frame, but only in those frames following (2-8). The problem also seems to relate for the most part with the last textbox in a frame, which mine isn't. I've run into some 404 errors if tracking down a solution (apparently one from MS requires adding a commandbutton, which really if I can avoid I'd like to). I found another [external link], but not sure if it's a solution to my problem or not, and without knowing where to put it, I can't even really test it fairly.

frm_services.frm
frm_services.frx
 
Upvote 0
OK ... something unusual, in a good way, happened. If we consider what is done with a "service" using service 2 as an example. Completing service one unhides service 2's frame (frm_service), which contains 8 controls, 2 checkboxes, 2 textboxes and 4 comboboxes. All controls with the exception of the two checkboxes (cbx_s2_rln and cbx_s2_chg) are disabled.

1. The user selects one of the two checkboxes. Lets suppose the user checks cbx_s2_rln.
2. The click event will code enable the first textbox, and send focus to it (via Jaafar's method) by way of a common procedure in a standard module (cbx_reline). This works flawlessly ... thecursor is available in the formatted textbox tb_s2_lwr allowing the user to enter a value without having to click anywhere.
3. On tabbing out, the tb_s2_lwr code exit code is supposed to trigger thus enabling the next textbox, tb_s2_upr, formatting it and sending focus to it (via Jaafar's method). This has not been happening. Focus is being sent to some other textbox outside the frame. The exit code is not being triggered. For the exit code to trigger, the user has to click the tb_s2_upr control.
4After the user has entered their value into tb_s2_upr, tabbing will trigger the beforeupdate code which enables the next control, a combobox, formats it, and sends focus to it (Jaafar's method). This works flawlessly. The cursor is waiting for input by the user without the user having to select the control.

I pretty much gave up, hoping for someone to point out the obvious solution, which I'm fearing there may not be one. So I continued to do some more coding.

I added this code, in blue, to the cbx_reline procedure ...
Rich (BB code):
Sub cbx_reline(ByVal frmservice As Object, index As Integer)
    'Stop
    If Not mbevents Then Exit Sub
    mbevents = False
    With frmservice
        If .Controls("cbx_s" & index & "_rln").Value = True Then
            .Controls("cbx_s" & index & "_chg").Value = False
            With .Controls("tb_s" & index & "_lwr")
                .Enabled = True
                .Value = ""
                .BackColor = RGB(206, 234, 232)
            End With
            .Controls("lbl_s" & index & "_1").Enabled = True
            ForceFocus .Controls("tb_s" & index & "_lwr")
            .Controls("tb_s" & index & "_lwr").SetFocus
            'mbevents = True
        Else
            'Stop
            .Controls("cbx_s" & index & "_chg").Value = False
            With .Controls("tb_s" & index & "_lwr")
                .Enabled = False
                .Value = ""
                .BackColor = vbWhite
            End With
            With .Controls("tb_s" & index & "_upr")
                .Enabled = False
                .Value = ""
                .BackColor = vbWhite
            End With
            With .Controls("cb_s" & index & "_crew")
                .Enabled = False
                .Value = ""
                .BackColor = vbWhite
            End With
            With .Controls("cb_s" & index & "_div")
                .Enabled = False
                .Value = ""
                .BackColor = vbWhite
            End With
            With .Controls("cb_s" & index & "_base")
                .Enabled = False
                .Value = ""
                .BackColor = vbWhite
            End With
            With .Controls("cb_s" & index & "_pitch")
                .Enabled = False
                .Value = ""
                .BackColor = vbWhite
            End With
            For I = 1 To 6
                .Controls("lbl_s" & index & "_" & I).Enabled = False
                .Controls("lbl_s" & index & "_" & I).BackColor = RGB(0, 128, 128)
            Next I
            .Controls("cbt_s" & index & "_add").Enabled = False
            mbevents = True
            Exit Sub
            'mbevents = True
        End If
    
        For I = 2 To 6
            .Controls("lbl_s" & index & "_" & I).Enabled = False
            .Controls("lbl_s" & index & "_" & I).BackColor = RGB(0, 128, 128)
        Next I
    
        With .Controls("tb_s" & index & "_upr")
            .Value = ""
            .Enabled = False
            .BackColor = vbWhite
        End With
        With .Controls("cb_s" & index & "_crew")
            .Value = ""
            .Enabled = False
            .BackColor = vbWhite
        End With
        
        If index = 1 Then 'pull reline data from original
            With .Controls("cb_s" & index & "_div")
                .Value = ws_thold.Cells(1, 27).Value
                .Enabled = False
                .BackColor = vbWhite
            End With
            With .Controls("cb_s" & index & "_pitch")
                .Value = ws_thold.Cells(1, 32).Value
                .Enabled = False
                .BackColor = vbWhite
            End With
            With .Controls("cb_s" & index & "_base")
                .Value = ws_thold.Cells(1, 31).Value
                .Enabled = False
                .BackColor = vbWhite
            End With
        Else 'pull reline data from previous service in core_data
            psrvc = index - 1
            If psrvc = 1 Then 'from 2
                pdiv = ws_cd.Cells(cd_rrow, 41)
                pbase = ws_cd.Cells(cd_rrow, 42)
                ppitch = ws_cd.Cells(cd_rrow, 43)
            ElseIf psrvc = 2 Then 'from 3
                pdiv = ws_cd.Cells(cd_rrow, 48)
                pbase = ws_cd.Cells(cd_rrow, 49)
                ppitch = ws_cd.Cells(cd_rrow, 50)
            ElseIf psrvc = 3 Then 'from 4
                pdiv = ws_cd.Cells(cd_rrow, 55)
                pbase = ws_cd.Cells(cd_rrow, 56)
                ppitch = ws_cd.Cells(cd_rrow, 57)
            ElseIf psrvc = 4 Then 'from 5
                pdiv = ws_cd.Cells(cd_rrow, 62)
                pbase = ws_cd.Cells(cd_rrow, 63)
                ppitch = ws_cd.Cells(cd_rrow, 64)
            ElseIf psrvc = 5 Then 'from 6
                pdiv = ws_cd.Cells(cd_rrow, 68)
                pbase = ws_cd.Cells(cd_rrow, 69)
                ppitch = ws_cd.Cells(cd_rrow, 70)
            ElseIf psrvc = 6 Then 'from 7
                pdiv = ws_cd.Cells(cd_rrow, 76)
                pbase = ws_cd.Cells(cd_rrow, 78)
                ppitch = ws_cd.Cells(cd_rrow, 79)
            Else    'psrvc = 7 Then from 7
                pdiv = ws_cd.Cells(cd_rrow, 83)
                pbase = ws_cd.Cells(cd_rrow, 84)
                ppitch = ws_cd.Cells(cd_rrow, 85)
            End If
            
            With .Controls("cb_s" & index & "_div")
                .Value = pdiv
                .Enabled = False
                .BackColor = vbWhite
            End With
            With .Controls("cb_s" & index & "_pitch")
                .Value = ppitch
                .Enabled = False
                .BackColor = vbWhite
            End With
            With .Controls("cb_s" & index & "_base")
                .Value = pbase
                .Enabled = False
                .BackColor = vbWhite
            End With
        End If
            
        If index > 1 Then .Controls("cbt_s" & index & "_del").Enabled = True
        .Controls("cbt_s" & index & "_add").Enabled = False
        'mbevents = True
    End With
    mbevents = True

End Sub

After adding this code, what wasn't working in step 3 of the process ... is!!! So now, after the user enters a value in tb_s2_rln, and tabs out, the focus and curso goes direct to the next control, tb_s2_upr. Unlike before this code was added, the user does no longer have to click.

This code has nothing to do with any of the controls that take the setfocus needs. I have no idea why this code is making a difference.

That being said, if the user originally selects the alternate checkbox, cbx_s2_chg, the process will function the same way cbx_s2_rln ORIGINALLY did. So, I don't know what to to to the cbx_s2_chg code (that was done to cbx_s2_rln code that got it working)? I can't add that code because it doesn't apply to the data needed for the CHG function.

Based on this new revelation, can anyone offer a solution as to how I can fix cbx_s2_chg?
 
Upvote 0
Mystery solved ... I think.
I had to add this line (in green) to make it work in both the cbx_rln and cbx_chg code.
Rich (BB code):
ForceFocus .Controls("tb_s" & index & "_lwr")
.Controls("tb_s" & index & "_lwr").SetFocus

I am not the person to explain why it works. That requires someone a bit more VBA/Excel savvy than I.
 
Upvote 0

Forum statistics

Threads
1,224,827
Messages
6,181,195
Members
453,021
Latest member
pingpong7117

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