Question re: VBA ComboBox with many items

leopardhawk

leopardhawk

Well-known Member
Joined
May 31, 2007
Messages
611
Office Version
  1. 2016
Platform
  1. Windows
Hello forum friends, can anyone suggest the best way to code a ComboBox in VBA that would potentially have a few hundred items in it?? It will be for users to select a year, starting say with 1930 and going as high as 2230.

I'm just not sure whether 'array' or 'additem' would be better or maybe I should be looking at some other alternative, like a text box with a spinner on it???

Hoping for ideas! Thanks!
 
Sort by date Sort by votes
@Fluff the code is being run when the user clicks on the PersonalInfoUserForm button to open the userform. The whole code is below.
VBA Code: 
Private Sub CloseCommandButton_Click()

Unload Me

End Sub

Private Sub GenderComboBox_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
   With Me.GenderComboBox
      If .Text = "M" Or .Text = "F" Or .Text = "" Then
         .BackColor = rgbWhite
         Label4.Caption = "Gender"
         Label4.ForeColor = rgbBlack
      Else
         Label4.Caption = "Please select M or F"
         Label4.ForeColor = RGB(255, 55, 55)
         .BackColor = RGB(255, 55, 55)
         GenderComboBox.Value = ""
      End If
   End With
End Sub

Private Sub SGenderComboBox_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
   With Me.SGenderComboBox
      If .Text = "M" Or .Text = "F" Or .Text = "" Then
         .BackColor = rgbWhite
         Label24.Caption = "Gender"
         Label24.ForeColor = rgbBlack
      Else
         Label24.Caption = "Please select M or F"
         Label24.ForeColor = RGB(255, 55, 55)
         .BackColor = RGB(255, 55, 55)
         SGenderComboBox.Value = ""
      End If
   End With
End Sub

Private Sub UserForm_Initialize()
Dim objControl As MSForms.Control

    For Each objControl In Me.Controls
        If TypeName(objControl) = "TextBox" And objControl.Tag <> "" Then
           Me.setupPlaceholder objControl.Name, False
        End If
    Next objControl

    MultiPage1.Value = 0
    Me.FirstNameTextBox.SetFocus
       
    'Fill MonthComboBox
    With MonthComboBox
        .AddItem "January"
        .AddItem "February"
        .AddItem "March"
        .AddItem "April"
        .AddItem "May"
        .AddItem "June"
        .AddItem "July"
        .AddItem "August"
        .AddItem "September"
        .AddItem "October"
        .AddItem "November"
        .AddItem "December"
    End With
   
    Dim Arry As Variant
   
        Arry = Evaluate("if({1},row(1:31))")
        Me.DayComboBox.List = Arry
   
    Dim Ary As Variant
   
        Ary = Evaluate("if({1},row(1930:2130))")
        Me.YearComboBox.List = Ary
   
    Dim Dob As Variant
        Dob = DateSerial(Me.YearComboBox, Me.MonthComboBox, Me.DayComboBox)
   
    Me.GenderComboBox.List = Array("M", "F")
    Me.GenderComboBox.Style = fmStyleDropDownCombo
   
    Me.OptionComboBox.List = Array("100% Joint Life", _
        "100% Joint Life 5-year guarantee", "100% Joint Life 10-year guarantee", "100% Joint Life 15-year guarantee", _
        "75% Joint Life 5-year guarantee", "75% Joint Life 10-year guarantee", "75% Joint Life 15-year guarantee", _
        "60% Joint Life 5-year guarantee", "60% Joint Life 10-year guarantee", "60% Joint Life 15-year guarantee", _
        "Single Life", _
        "Single Life 5-year guarantee", "Single Life 10-year guarantee", "Single Life 15-year guarantee", _
        "Other")

    Dim LastRow As Long
    Dim SheetName As String
    SheetName = "Sheet20"
    LastRow = Sheets(SheetName).Cells(Rows.Count, "A").End(xlUp).Row
    Me.ProviderComboBox.List = Sheets("Sheet20").Range("A2:A" & LastRow).Value
    Me.SProviderComboBox.List = Sheets("Sheet20").Range("A2:A" & LastRow).Value
   
    Me.SGenderComboBox.List = Array("M", "F")
    Me.SGenderComboBox.Style = fmStyleDropDownCombo
   
    Me.SOptionComboBox.List = Array("100% Joint Life", _
        "100% Joint Life 5-year guarantee", "100% Joint Life 10-year guarantee", "100% Joint Life 15-year guarantee", _
        "75% Joint Life 5-year guarantee", "75% Joint Life 10-year guarantee", "75% Joint Life 15-year guarantee", _
        "60% Joint Life 5-year guarantee", "60% Joint Life 10-year guarantee", "60% Joint Life 15-year guarantee", _
        "Single Life", _
        "Single Life 5-year guarantee", "Single Life 10-year guarantee", "Single Life 15-year guarantee", _
        "Other")

End Sub

Private Sub MultiPage1_Change()

    GetTextBoxByTabIndex(Me.MultiPage1.SelectedItem, 0).SetFocus

End Sub

Private Function GetTextBoxByTabIndex(ByVal ControlParent As Object, ByVal TabIndex As Long) As Control

    Dim oCtrl As Control
   
    For Each oCtrl In ControlParent.Controls
        If TypeOf oCtrl Is MSForms.TextBox Then
            If oCtrl.TabIndex = TabIndex Then
                Set GetTextBoxByTabIndex = oCtrl
                Exit For
            End If
        End If
    Next oCtrl

End Function

Private Sub OKCommandButton_Click()

    With Sheets(11)

        .Unprotect Password:="passwordhere"
        If Not AllmostEmpty(FirstNameTextBox) Then .Range("C9").Value = FirstNameTextBox.Value
               
        If LastNameTextBox <> "Optional" Then
            If Not AllmostEmpty(LastNameTextBox) Then .Range("D9").Value = LastNameTextBox.Value
        End If
       
        If Not AllmostEmpty(Dob) Then .Range("E9").Value = Dob.Value
        If Not AllmostEmpty(GenderComboBox) Then .Range("F9").Value = GenderComboBox.Value
       
        If CompanyTextBox <> "Optional" Then
            If Not AllmostEmpty(CompanyTextBox) Then .Range("G9").Value = CompanyTextBox.Value
        End If
       
        If Not AllmostEmpty(RDTextBox) Then .Range("C15").Value = RDTextBox.Value
        If Not AllmostEmpty(OptionComboBox) Then .Range("D15").Value = OptionComboBox.Value
        If Not AllmostEmpty(ProviderComboBox) Then .Range("E15").Value = ProviderComboBox.Value
        If Not AllmostEmpty(CPPTextBox) Then .Range("F15").Value = CPPTextBox.Value
        If Not AllmostEmpty(OASTextBox) Then .Range("G15").Value = OASTextBox.Value
        .Protect Password:="passwordhere"
    End With
       
    With Sheets(11)

        .Unprotect Password:="passwordhere"
        If Not AllmostEmpty(SFirstNameTextBox) Then .Range("C11").Value = SFirstNameTextBox.Value
       
        If SLastNameTextBox <> "Optional" Then
            If Not AllmostEmpty(SLastNameTextBox) Then .Range("D11").Value = SLastNameTextBox.Value
        End If
       
        If Not AllmostEmpty(SDOBTextBox) Then .Range("E11").Value = SDOBTextBox.Value
        If Not AllmostEmpty(SGenderComboBox) Then .Range("F11").Value = SGenderComboBox.Value
       
        If SCompanyTextBox <> "Optional" Then
            If Not AllmostEmpty(SCompanyTextBox) Then .Range("G11").Value = SCompanyTextBox.Value
        End If
       
        If Not AllmostEmpty(SRDTextBox) Then .Range("C17").Value = SRDTextBox.Value
        If Not AllmostEmpty(SOptionComboBox) Then .Range("D17").Value = SOptionComboBox.Value
        If Not AllmostEmpty(SProviderComboBox) Then .Range("E17").Value = SProviderComboBox.Value
        If Not AllmostEmpty(SCPPTextBox) Then .Range("F17").Value = SCPPTextBox.Value
        If Not AllmostEmpty(SOASTextBox) Then .Range("G17").Value = SOASTextBox.Value
        .Protect Password:="passwordhere"
    End With
   
Unload Me
   
End Sub

Private Sub SDOBTextBox_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim dt As Date, tx As String
With SDOBTextBox
If .Value = "" Then Exit Sub
    If IsDate(.Value) Then
        tx = .Value
        dt = Format(.Value, "dd/mm/yyyy")
       
        If (dt > Date) Or (Year(CDate(.Value)) < 1000) Then
            MsgBox "Please enter the year as four digits."
            Cancel = True
        Else
            .Value = dt
       
        End If
   
    Else
        MsgBox "Please enter a valid date!"
        Cancel = True
        .Value = Empty
    End If
End With

End Sub

Private Sub RDTextBox_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim dt As Date, tx As String
With RDTextBox
If .Value = "" Then Exit Sub
    If IsDate(.Value) Then
        tx = .Value
        dt = Format(.Value, "dd/mm/yyyy")
       
        If (dt > Date) Or (Year(CDate(.Value)) < 1000) Then
            MsgBox "Please enter the year as four digits."
            Cancel = True
        Else
            .Value = dt
       
        End If
   
    Else
        MsgBox "Please enter a valid date!"
        Cancel = True
        .Value = Empty
    End If
End With

End Sub

Private Sub SRDTextBox_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim dt As Date, tx As String
With SRDTextBox
If .Value = "" Then Exit Sub
    If IsDate(.Value) Then
        tx = .Value
        dt = Format(.Value, "dd/mm/yyyy")
       
        If (dt > Date) Or (Year(CDate(.Value)) < 1000) Then
            MsgBox "Please enter the year as four digits."
            Cancel = True
        Else
            .Value = dt
       
        End If
   
    Else
        MsgBox "Please enter a valid date!"
        Cancel = True
        .Value = Empty
    End If
End With

End Sub

Private Sub CPPTextBox_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim dt As Date, tx As String
With CPPTextBox
If .Value = "" Then Exit Sub
    If IsDate(.Value) Then
        tx = .Value
        dt = Format(.Value, "dd/mm/yyyy")
       
        If (dt > Date) Or (Year(CDate(.Value)) < 1000) Then
            MsgBox "Please enter the year as four digits."
            Cancel = True
        Else
            .Value = dt
       
        End If
   
    Else
        MsgBox "Please enter a valid date!"
        Cancel = True
        .Value = Empty
    End If
End With

End Sub

Private Sub SCPPTextBox_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim dt As Date, tx As String
With SCPPTextBox
If .Value = "" Then Exit Sub
    If IsDate(.Value) Then
        tx = .Value
        dt = Format(.Value, "dd/mm/yyyy")
       
        If (dt > Date) Or (Year(CDate(.Value)) < 1000) Then
            MsgBox "Please enter the year as four digits."
            Cancel = True
        Else
            .Value = dt
       
        End If
   
    Else
        MsgBox "Please enter a valid date!"
        Cancel = True
        .Value = Empty
    End If
End With

End Sub

Private Sub OASTextBox_AfterUpdate()
Dim dt As Date, tx As String
With OASTextBox
If .Value = "" Then Exit Sub
    If IsDate(.Value) Then
        tx = .Value
        dt = Format(.Value, "dd/mm/yyyy")
       
        If (dt > Date) Or (Year(CDate(.Value)) < 1000) Then
            MsgBox "Please enter the year as four digits."
            Cancel = True
        Else
            .Value = dt
       
        End If
   
    Else
        MsgBox "Please enter a valid date!"
        Cancel = True
        .Value = Empty
    End If
End With

End Sub

Private Sub SOASTextBox_AfterUpdate()
Dim dt As Date, tx As String
With SOASTextBox
If .Value = "" Then Exit Sub
    If IsDate(.Value) Then
        tx = .Value
        dt = Format(.Value, "dd/mm/yyyy")
       
        If (dt > Date) Or (Year(CDate(.Value)) < 1000) Then
            MsgBox "Please enter the year as four digits."
            Cancel = True
        Else
            .Value = dt
       
        End If
   
    Else
        MsgBox "Please enter a valid date!"
        Cancel = True
        .Value = Empty
    End If
End With

End Sub

Sub setupPlaceholder(txtBox As String, focus As Boolean)
    With Me.Controls(txtBox)
        If Len(.Text) = 0 And Not focus Then
            .Text = .Tag
            .ForeColor = vbGrayText
        ElseIf .Text = .Tag Then
            .Text = ""
            .ForeColor = vbWindowText
        End If
    End With
End Sub

Private Sub LastNameTextBox_Enter()
    setupPlaceholder LastNameTextBox.Name, True
End Sub

Private Sub LastNameTextBox_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    setupPlaceholder LastNameTextBox.Name, False
End Sub

Private Sub CompanyTextBox_Enter()
    setupPlaceholder CompanyTextBox.Name, True
End Sub

Private Sub CompanyTextBox_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    setupPlaceholder CompanyTextBox.Name, False
End Sub

Private Sub SLastNameTextBox_Enter()
    setupPlaceholder SLastNameTextBox.Name, True
End Sub

Private Sub SLastNameTextBox_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    setupPlaceholder SLastNameTextBox.Name, False
End Sub

Private Sub SCompanyTextBox_Enter()
    setupPlaceholder SCompanyTextBox.Name, True
End Sub

Private Sub SCompanyTextBox_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    setupPlaceholder SCompanyTextBox.Name, False
End Sub

Private Sub ProviderComboBox_Change()
    If ProviderComboBox.TextLength > 42 Then
    MsgBox "Please limit your input to 42 characters."
    ProviderComboBox.Text = Left(ProviderComboBox, ProviderComboBox.TextLength - 1)
    End If
End Sub

Private Sub SProviderComboBox_Change()
    If SProviderComboBox.TextLength > 42 Then
    MsgBox "Please limit your input to 42 characters."
    SProviderComboBox.Text = Left(SProviderComboBox, SProviderComboBox.TextLength - 1)
    End If
End Sub

Private Sub OptionComboBox_Change()
    If OptionComboBox.TextLength > 34 Then
    MsgBox "Please limit your input to 34 characters."
    OptionComboBox.Text = Left(OptionComboBox, OptionComboBox.TextLength - 1)
    End If
End Sub

Private Sub SOptionComboBox_Change()
    If SOptionComboBox.TextLength > 34 Then
    MsgBox "Please limit your input to 34 characters."
    SOptionComboBox.Text = Left(SOptionComboBox, SOptionComboBox.TextLength - 1)
    End If
End Sub

Private Sub FirstNameTextBox_Change()
    If FirstNameTextBox.TextLength > 13 Then
    MsgBox "Please limit your input to 13 characters."
    FirstNameTextBox.Text = Left(FirstNameTextBox, FirstNameTextBox.TextLength - 1)
    End If
End Sub

Private Sub SFirstNameTextBox_Change()
    If SFirstNameTextBox.TextLength > 13 Then
    MsgBox "Please limit your input to 13 characters."
    SFirstNameTextBox.Text = Left(SFirstNameTextBox, SFirstNameTextBox.TextLength - 1)
    End If
End Sub

Private Sub LastNameTextBox_Change()
    If LastNameTextBox.TextLength > 28 Then
    MsgBox "Please limit your input to 28 characters."
    LastNameTextBox.Text = Left(LastNameTextBox, LastNameTextBox.TextLength - 1)
    End If
End Sub

Private Sub SLastNameTextBox_Change()
    If SLastNameTextBox.TextLength > 28 Then
    MsgBox "Please limit your input to 28 characters."
    SLastNameTextBox.Text = Left(SLastNameTextBox, SLastNameTextBox.TextLength - 1)
    End If
End Sub

Private Sub CompanyTextBox_Change()
    If CompanyTextBox.TextLength > 30 Then
    MsgBox "Please limit your input to 30 characters."
    CompanyTextBox.Text = Left(CompanyTextBox, CompanyTextBox.TextLength - 1)
    End If
End Sub

Private Sub SCompanyTextBox_Change()
    If SCompanyTextBox.TextLength > 30 Then
    MsgBox "Please limit your input to 30 characters."
    SCompanyTextBox.Text = Left(SCompanyTextBox, SCompanyTextBox.TextLength - 1)
    End If
End Sub
 
Last edited by a moderator:
Upvote 0

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December
This
VBA Code: 
Dim Dob As Variant
        Dob = DateSerial(Me.YearComboBox, Me.MonthComboBox, Me.DayComboBox)
needs to go in the Private Sub OKCommandButton_Click()event
Although as you have month names & not numbers you will probably need to use
VBA Code: 
   Dob = DateSerial(Me.YearComboBox, Month(DateValue("1/" & Me.MonthComboBox& "/2020")), Me.DayComboBox)
or
VBA Code: 
   Dob = DateSerial(Me.YearComboBox, Month(DateValue( Me.MonthComboBox& "/01/2020")), Me.DayComboBox)
 
Upvote 0
Solution
@Fluff I think we're getting there but I am still getting errors as described below. I moved the
VBA Code: 
Dim Dob As Variant
        Dob = DateSerial(Me.YearComboBox, Me.MonthComboBox, Me.DayComboBox)
to the Private Sub OKCommandButton_Click() event. With both of your modifications, the second line turns red as soon as I move away from it, and when run the code I am getting a compile error syntax error with the yellow highlight on the Private Sub OKCommandButton_Click().

I tried going back to the original code
VBA Code: 
Dim Dob As Variant
        Dob = DateSerial(Me.YearComboBox, Me.MonthComboBox, Me.DayComboBox)
and when I run the code I get a compile error 'ByRef argument type mismatch'. With this error, the yellow highlight is on the Private Sub OKCommandButton_Click() but the Dob is also highlighted in blue.

So, errors on all three. I so appreciate you helping me, please tell me there is a solution. Thanks!!!
 
Upvote 0
What happened when you tried
VBA Code: 
   Dob = DateSerial(Me.YearComboBox, Month(DateValue( Me.MonthComboBox& "/01/2020")), Me.DayComboBox)
 
Upvote 0
leopardhawk said:
With both of your modifications, the second line turns red as soon as I move away from it, and when run the code I am getting a compile error syntax error with the yellow highlight on the Private Sub OKCommandButton_Click().
Click to expand...
I tried both of your mods and received errors with both...
 
Upvote 0
@Fluff I note that there are two 'open brackets' and three 'close brackets' in your code. Is that intentional?
 
Upvote 0
I see 3 of each
Rich (BB code): 
   Dob = DateSerial(Me.YearComboBox, Month(DateValue( Me.MonthComboBox& "/01/2020")), Me.DayComboBox)
 
Upvote 0
You're right, must be getting old. Where does that leave us?
 
Upvote 0
Fluff said:
What happened when you tried
VBA Code: 
   Dob = DateSerial(Me.YearComboBox, Month(DateValue( Me.MonthComboBox& "/01/2020")), Me.DayComboBox)
Click to expand...
When I paste this line of code, I get "Compile error: Expected list separator or )" then if I run the code I get a syntax error. Should there be a space after MonthComboBox?

Not sure what I should rename Dob to... can it be anything at all???
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Solved
When _Change() dynamically clears and re-adds items to ComboBox, box remains null when selecting item
Replies
8
Views
888
T1E1
T
sanantonio
  • Solved
Recommend a method please! VBA / formatting
Replies
7
Views
239
sanantonio
sanantonio
A
  • Solved
Calendar form cancel button passing data to worksheet
Replies
7
Views
395
AndyEd
A
Young Grasshopper
  • Solved
Excel VBA UserForm / Linking text in combobox/textbox to selected line in listbox
Replies
9
Views
853
Legacy 143009
L
A
  • Solved
Calendar issue
Replies
1
Views
1K
AndyEd
A

Forum statistics

Threads
1,214,908
Messages
6,122,186
Members
449,071
Latest member
cdnMech

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