Userform Combobox Rowsource Contents Duplicated

A

Ark68

Well-known Member
Joined
Mar 23, 2004
Messages
4,616
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
I have a userform ("frm_tservices') that has a combobox ("cb_s" & index & "_crew") where index is a variable representing a number of 1 - 8. The listy source for this combobox is dynamic and is created through my vba code. This list is generated and stored in worksheet THold at column N1. The code then names that generated range as "nr_t1".

At userform initialization, the range column of column N1 is empty.

The first interaction between the user is to select from 1 of 2 checkboxes ("cbx_s" & index & "_rln" or "cbx_s" & index & "_chg"). A selection of either enables the next textbox ("tb_s" & index & "_lwr"). Once the user successfully enters a value in this textbox, the next text box ("tb_s" & index & "_upr") is enabled allowing the user to enter a value in it. The userform fields only become accessible as fields preceding them have valid user entries in them. When a value for "tb_s" & index & "_upr" is entered, the list source for combobox ("cb_s" & index & "_crew") is created, named and applied as the rowsource.

Suppose the user selected "cbx_s1"_rln".
Code: 
Private Sub cbx_s1_rln_Click()
    Debug.Print "frm_tservices>cbx_s1_rln_click - OK"
    If Not mbevents Then Exit Sub
    Me.cbx_s1_rln.ForeColor = RGB(0, 0, 128) 'blue text
    Me.cbx_s1_chg.ForeColor = RGB(0, 0, 128) 'blue text
    cbx_reline Me  '{frm_trn_services}*
End Sub

Rich (BB code): 
Sub cbx_reline(ByVal frmservice As Object)
    If Not mbevents Then Exit Sub
    mbevents = False
    With frmservice
        'if reline ob tournament service 'index'(public) is checked
        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
        Else
            .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
            '.  .  .
            mbevents = True
            Exit Sub
            'mbevents = True
        End If
    
        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

    End With
    mbevents = True
End Sub

At this point, cbx_s1_rln.Value = True; cbx_s1_chg.Value = False; tb_s1_lwr is enabled and waiting for the user to enter a value; tb_s1_upr and cb_s1_crew have no values and are disabled.

The user enters a valid value in tb_s1_lwr thus making tb_s1_upr accessible for user entry.

The user proceeds to provide a valid entry to tb_s1_upr (time) which initiates code to build the list of values in worksheet THold.Range N1. It assigns that nelwy created range a name of "nr_n1" and assigns that named ranges as the combobox rowsource.

Rich (BB code): 
Sub tb_upper(ByVal frmservice As Object) ', index As Integer)
    Dim crew as range
    Dim rng_r1 As Range
    
    If Not mbevents Then Exit Sub
    mbevents = False
    
    With frmservice
        With .Controls("tb_s" & index & "_upr")
            ForceFocus frmservice.Controls("tb_s" & index & "_upr")

            If IsDate(.Value) Then
                .Value = Format(.Value, "H:MMA/P")
                .BackColor = RGB(255, 255, 255) 'white
                svc_end = TimeValue(.Value)
                supr_time = CDbl(bkg_date + svc_end)
                
                'is time within the booking
                If supr_time <= bkg_dst Or supr_time >= bkg_det Then
                    MsgBox "The service time entered is outside the booking time.", vbExclamation, "INVALID TIME ENTRY"
                    .Value = ""
                    .BackColor = RGB(206, 234, 232)
                    Cancel = True
                    ForceFocus frmservice.Controls("tb_s" & index & "_upr")
                    frmservice.Controls("tb_s" & index & "_upr").SetFocus
                    frmservice.Controls("cb_s" & index & "_crew").Enabled = False
                    frmservice.Controls("cb_s" & index & "_crew").BackColor = RGB(255, 255, 255)
                    frmservice.Controls("lbl_s" & index & "_3").Enabled = False
                    mbevents = True
                    Exit Sub
                End If

                'is date after the lower range time
                svc_start = TimeValue(frmservice.Controls("tb_s" & index & "_lwr").Value)
                slwr_time = CDbl(bkg_date + svc_start)
                If CDbl(supr_time) < slwr_time Then
                    MsgBox "The service time entered has to be equal (no range) to or later that the lower range time.", vbExclamation, "INVALID TIME ENTRY"
                    .Value = ""
                    .BackColor = RGB(206, 234, 232)
                    ForceFocus frmservice.Controls("tb_s" & index & "_upr")
                    frmservice.Controls("tb_s" & index & "_upr").SetFocus
                    Cancel = True
                    frmservice.Controls("cb_s" & index & "_crew").Enabled = False
                    frmservice.Controls("cb_s" & index & "_crew").BackColor = RGB(255, 255, 255)
                    frmservice.Controls("lbl_s" & index & "_3").Enabled = False
                    mbevents = True
                    Exit Sub
                End If

                'define the dropdown list for crew checkbox
               frmservice.Controls("cb_s" & index & "_crew").RowSource = ""
                
                With ws_master
                    ws_thold.Range("N2:N100").Clear
                    dtr = 2
                    dtc = 14 'column N
                    For L1 = 10 To 37
                        'staff start
                        If .Cells(L1, 20) <> "" Then
                            stf_start = CDbl(bkg_date + .Cells(L1, 20))
                            stf_end = CDbl(bkg_date + .Cells(L1, 21))
                            If stf_end < stf_start Then stf_end = CDbl(bkg_date + 1 + .Cells(L1, 21))
                            If slwr_time > stf_start And slwr_time < stf_end Then 'so far so good - lwr range within shift
                                If supr_time > stf_start And supr_time < stf_end Then 'both ranges within shift
                                    cw = .Cells(L1, 19)
                                    ws_thold.Cells(dtr, dtc) = cw
                                    dtr = dtr + 1
                                End If
                            End If
                        End If
                    Next L1

                    'delete any previous named range (nr_r1) - tournament services crew selection                    
                    On Error Resume Next
                    'nr_r1.Delete                                                                                                    
                    ActiveWorkbook.Names("nr_r1").Delete
                    On Error GoTo 0
                    
                    Set rng_r1 = ws_thold.Range("N2:N" & dtr)
                    ThisWorkbook.Names.Add Name:="nr_r1", RefersTo:=rng_r1
                    For Each crew In Range("nr_r1")
                        frmservice.Controls("cb_s" & index & "_crew").AddItem crew.Value
                    Next crew
                End With 
    
                With frmservice.Controls("cb_s" & index & "_crew")
                    .Enabled = True
                    .BackColor = RGB(206, 234, 232)
                    ForceFocus frmservice.Controls("cb_s" & index & "_crew")
                    '.SetFocus
                End With

                frmservice.Controls("lbl_s" & index & "_3").Enabled = True
                frmservice.Controls("lbl_s" & index & "_2").BackColor = RGB(0, 128, 128)
        
            Else
                With frmservice.Controls("tb_s" & index & "_upr")
                    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
                    ForceFocus frmservice.Controls("tb_s" & index & "_upr")
                    frmservice.Controls("tb_s" & index & "_upr").SetFocus
                    mbevents = True
                    Exit Sub
                End With
                mbevents = True
            End If

        End With
    
    mbevents = True
    End With 'end frm_service
End Sub

In this case, cb_s1_crew has 6 values to select from.

Now, this is where I start encountering a odd situation. Suppose now, the user changes their mind and instead of wanting to select cbx_s1_rln at the beginning, they select cbx_s1_chg instead.

Rich (BB code): 
Private Sub cbx_s1_chg_Click()
    If Not mbevents Then Exit Sub
    Me.cbx_s1_rln.ForeColor = RGB(0, 0, 128)
    Me.cbx_s1_chg.ForeColor = RGB(0, 0, 128)
    cbx_change Me ', 1 '{frm_trn_services}*
End Sub

Rich (BB code): 
Sub cbx_change(ByVal frmservice As Object) ', index As Integer)
  
    If Not mbevents Then Exit Sub
    mbevents = False
    
    With frmservice
        If .Controls("cbx_s" & index & "_chg").Value = True Then
            .Controls("cbx_s" & index & "_rln").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   '******
        Else
            .Controls("cbx_s" & index & "_rln").Value = False
            With .Controls("tb_s" & index & "_lwr")
                .Enabled = False
                .Value = ""
                .BackColor = vbWhite
            End With
            .Controls("lbl_s" & index & "_1").Enabled = False
        End If
      
        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 .Controls("cbt_s" & index & "_del").Enabled = True
        '.Controls("cbt_s" & index & "_add").Enabled = False
    End With
    mbevents = True
    
End Sub

At this point, cbx_s1_rln.Value = False; cbx_s1_chg.Value = True; tb_s1_lwr is enabled, no value and waiting for the user to enter a value; tb_s1_upr and cb_s1_crew have no values and are disabled. cb_s1_crew I believe (?) still has the rowsource assigned from earlier.

The user enters a valid value in tb_s1_lwr thus making tb_s1_upr accessible for user entry.

The user proceeds to provide a valid entry to tb_s1_upr (time) which initiates code to build the list of values in worksheet THold.Range N1. It assigns that nelwy created range a name of "nr_n1" and assigns that named ranges as the combobox rowsource.

Now, unlike the first time around where the combox cb_s1_crew had 6 values to select from, it has 12. Their is a set of 6 values, separated by a space, and then a repeat of the 6 values. The values are duplicated in the rowsource. A look at the list source list on worksheet THold column N1 shows only the 6 values.

I'm hoping someone can help me understand why the values of the list are being duplicated and how to resolve this. In this example, the user chose cbx_s1_rln first then changed their mind and selected cbx_s1_chg. This situation can be recreated similarly if the user first selects cbx_s1_chg then changes their mind and selects cbx_s1_rln.
 

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)
Sort by date Sort by votes
You clear the Rowsource property (so that's no longer being used), then you use AddItem to populate the control but you don't clear any existing items first. So if that code runs again, you add the same items to the ones that are already there.
 
Upvote 0
Hi Rory! Thanks for your insight. So two things I'm trying to wrap my head around.

"You clear the Rowsource property (so that's no longer being used)" - Do I even need to use this?
Code: 
frmservice.Controls("cb_s" & index & "_crew").RowSource = ""

"hen you use AddItem to populate the control but you don't clear any existing items first" I'm not sure how to clear my list before I add more. My guess was that the code above took care of that, but the two are accomplishing different things obviously.

Something needs to go here in the tb_upper procedure ...

Code:
 
Upvote 0
Just frmservice.Controls("cb_s" & index & "_crew").clear before you start your additem loop.
 
Upvote 0
Solution
Thank you. That was far more simple than I expected it to be.
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question Question
Userform "Reset" - Set user focus on a particular control, contents highlighted, ready for user to overwrite
Replies
2
Views
137
Jaafar Tribak
Jaafar Tribak
J
  • Question Question
Userform inconsistent responses
Replies
1
Views
218
Candyman8019
C
A
  • Solved
Invalid Property value error setting focus of a userform checkbox
Replies
2
Views
446
Ark68
A
A
  • Question Question
Odd Behaviour With Code Results In RunTime vs Manually Stepping Through Same Code
Replies
6
Views
625
Ark68
A
R
  • Question Question
Search for values using an advanced search and update then display pivot table results in a userform listbox
Replies
1
Views
567
Rfriend
R

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,021
Latest member
Justyna P

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