Question re: VBA ComboBox with many items

leopardhawk

Well-known Member
Joined
May 31, 2007
Messages
587
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!
 

leopardhawk

Well-known Member
Joined
May 31, 2007
Messages
587
Office Version
  1. 2016
Platform
  1. Windows
@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:

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
58,395
Office Version
  1. 365
Platform
  1. Windows
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)
 
Solution

leopardhawk

Well-known Member
Joined
May 31, 2007
Messages
587
Office Version
  1. 2016
Platform
  1. Windows
@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!!!
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
58,395
Office Version
  1. 365
Platform
  1. Windows
What happened when you tried
VBA Code:
   Dob = DateSerial(Me.YearComboBox, Month(DateValue( Me.MonthComboBox& "/01/2020")), Me.DayComboBox)
 

leopardhawk

Well-known Member
Joined
May 31, 2007
Messages
587
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

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 both of your mods and received errors with both...
 

leopardhawk

Well-known Member
Joined
May 31, 2007
Messages
587
Office Version
  1. 2016
Platform
  1. Windows
@Fluff I note that there are two 'open brackets' and three 'close brackets' in your code. Is that intentional?
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
58,395
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

I see 3 of each
Rich (BB code):
   Dob = DateSerial(Me.YearComboBox, Month(DateValue( Me.MonthComboBox& "/01/2020")), Me.DayComboBox)
 

leopardhawk

Well-known Member
Joined
May 31, 2007
Messages
587
Office Version
  1. 2016
Platform
  1. Windows
You're right, must be getting old. Where does that leave us?
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
58,395
Office Version
  1. 365
Platform
  1. Windows
Try changing the name of the variable Dob.
 

leopardhawk

Well-known Member
Joined
May 31, 2007
Messages
587
Office Version
  1. 2016
Platform
  1. Windows
What happened when you tried
VBA Code:
   Dob = DateSerial(Me.YearComboBox, Month(DateValue( Me.MonthComboBox& "/01/2020")), Me.DayComboBox)
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???
 

Watch MrExcel Video

Forum statistics

Threads
1,133,243
Messages
5,657,578
Members
418,401
Latest member
B_A_M155

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
Top