How to use a ComboBox with autocomplete and search as you type, but ignore blank formula or empty cells.

Slayer_17

New Member
Joined
Feb 17, 2022
Messages
8
Office Version
  1. 2016
Platform
  1. Windows
Hi every one, sorry for my bad english
i found this thread on my searches and i loved the answer of the post#2


VBA Code:
Option Explicit

Dim IsArrow As Boolean
Dim ListRowsMaximum As Long
Dim ListRange As Range


Private Sub Init_Settings()

    'ListRange holds the cells to use in the combobox List
    
    With Worksheets("Data2")
        Set ListRange = .Range("A2", .Cells(Rows.Count, "A").End(xlUp)) ' <-----I think it must be here that I should change or add another variable but I don't know how
    End With

    'ListRowsMaximum is the original ListRows value - maximum number of displayed rows
    
    If ListRowsMaximum = 0 Then ListRowsMaximum = Me.ComboBox1.ListRows
    
End Sub


Private Sub ComboBox1_GotFocus()

    If ListRange Is Nothing Then Init_Settings
    
    'Initialise the combobox List with cell values from ListRange
    
    With Me.ComboBox1
        .List = ListRange.Value
        .ListRows = Application.WorksheetFunction.Min(ListRowsMaximum, .ListCount)
        .Text = ""
    End With
    
End Sub


Private Sub ComboBox1_DropButtonClick()
    
    If ListRange Is Nothing Then Init_Settings
    
    With Me.ComboBox1
        .List = ListRange.Value
        .ListRows = Application.WorksheetFunction.Min(ListRowsMaximum, .ListCount)
        .DropDown
    End With
    
End Sub


Private Sub ComboBox1_Change()

    Dim i As Long
    
    'Update the combobox List to only the items containing the current Text
    
    If Not IsArrow Then
        With Me.ComboBox1
            .List = ListRange.Value
            If Len(.Text) Then
                For i = .ListCount - 1 To 0 Step -1
                    If InStr(1, .List(i), .Text, vbTextCompare) = 0 Then .RemoveItem i

                Next
            End If
            .DropDown
            .ListRows = Application.WorksheetFunction.Min(ListRowsMaximum, .ListCount)
        End With
    End If
    
End Sub


Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
        
    With Me.ComboBox1
        .ListRows = Application.WorksheetFunction.Min(ListRowsMaximum, .ListCount)
    End With
        
    IsArrow = (KeyCode = vbKeyUp) Or (KeyCode = vbKeyDown)
    
    If KeyCode = vbKeyReturn Then
        Me.ComboBox1.List = ListRange.Value
    ElseIf KeyCode = vbKeyTab Then
        'Tab key selects first displayed item or highlighted item
        With Me.ComboBox1
            If .ListIndex = -1 Then
                .Value = .List(0)
            Else
                .Value = .List(.ListIndex)
            End If
        End With
        KeyCode = vbKeyReturn
    End If
    
End Sub

I tried everything and researched a lot how to make this code skip lines that have blank formula results and cells that don't contain data, but I failed miserably.
I understand little about excel vba, and I can only often join the codes in my spreadsheets.

I really appreciate the help in advance.
 

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).
You can also add the contents of an array to the combobox. So what the code below does is
1. Read the range into an array
2. Loop through the array and if cell is not empty then add to 2nd array
3. Put the second array into the combobox

Looping through an array is way quicker than looping through cells on a sheet. That is why it is used here.

VBA Code:
Option Explicit

Dim IsArrow As Boolean
Dim ListRowsMaximum As Long
Dim ListRange As Range
Dim vIn As Variant, vList As Variant


Private Sub UserForm_Activate() '<<<<<  Check your userforem activate (or initiate) to see that it calls Init_Settings

    Init_Settings


End Sub

Private Sub Init_Settings()
    Dim lRi As Long, lRl As Long
    'vList will hold the values to use in the combobox List
    ReDim vList(1 To 1)
    
    'first read the data set into an array vIn. This is far quicker then looping through each cell
    With Worksheets("sheet2")
        Set ListRange = [c3:c12]    '.Range("A2", .Cells(Rows.Count, "A").End(xlUp))
    End With
    vIn = ListRange.Value
    'Now go through each 'cell' of the array and check if empty
    For lRi = 1 To UBound(vIn, 1)
        If vIn(lRi, 1) <> "" Then
            lRl = lRl + 1
            ReDim Preserve vList(1 To lRl)  'add row to the array holding the list input, keeping any values already there
            'add the value from the input array to the list array
            vList(lRl) = vIn(lRi, 1)
        End If
    Next lRi

    'ListRowsMaximum is the original ListRows value - maximum number of displayed rows
    
    If ListRowsMaximum = 0 Then ListRowsMaximum = Me.ComboBox1.ListRows
    
End Sub


Private Sub ComboBox1_GotFocus()

    If ListRange Is Nothing Then Init_Settings
    
    'Initialise the combobox List with cell values from ListRange
    
    With Me.ComboBox1
        .List = vList
        .ListRows = Application.WorksheetFunction.Min(ListRowsMaximum, .ListCount)
        .Text = ""
    End With
    
End Sub


Private Sub ComboBox1_DropButtonClick()
    
    If ListRange Is Nothing Then Init_Settings
    
    With Me.ComboBox1
        .List = vList
        .ListRows = Application.WorksheetFunction.Min(ListRowsMaximum, .ListCount)
        .DropDown
    End With
    
End Sub


Private Sub ComboBox1_Change()

    Dim i As Long
    
    'Update the combobox List to only the items containing the current Text
    
    If Not IsArrow Then
        With Me.ComboBox1
            .List = vList
            If Len(.Text) Then
                For i = .ListCount - 1 To 0 Step -1
                    If InStr(1, .List(i), .Text, vbTextCompare) = 0 Then .RemoveItem i

                Next
            End If
            .DropDown
            .ListRows = Application.WorksheetFunction.Min(ListRowsMaximum, .ListCount)
        End With
    End If
    
End Sub


Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
        
    With Me.ComboBox1
        .ListRows = Application.WorksheetFunction.Min(ListRowsMaximum, .ListCount)
    End With
        
    IsArrow = (KeyCode = vbKeyUp) Or (KeyCode = vbKeyDown)
    
    If KeyCode = vbKeyReturn Then
        Me.ComboBox1.List = vList
    ElseIf KeyCode = vbKeyTab Then
        'Tab key selects first displayed item or highlighted item
        With Me.ComboBox1
            If .ListIndex = -1 Then
                .Value = .List(0)
            Else
                .Value = .List(.ListIndex)
            End If
        End With
        KeyCode = vbKeyReturn
    End If
    
End Sub
 
Upvote 0
Solution
You can also add the contents of an array to the combobox. So what the code below does is
1. Read the range into an array
2. Loop through the array and if cell is not empty then add to 2nd array
3. Put the second array into the combobox

Looping through an array is way quicker than looping through cells on a sheet. That is why it is used here.

VBA Code:
Option Explicit

Dim IsArrow As Boolean
Dim ListRowsMaximum As Long
Dim ListRange As Range
Dim vIn As Variant, vList As Variant


Private Sub UserForm_Activate() '<<<<<  Check your userforem activate (or initiate) to see that it calls Init_Settings

    Init_Settings


End Sub

Private Sub Init_Settings()
    Dim lRi As Long, lRl As Long
    'vList will hold the values to use in the combobox List
    ReDim vList(1 To 1)
   
    'first read the data set into an array vIn. This is far quicker then looping through each cell
    With Worksheets("sheet2")
        Set ListRange = [c3:c12]    '.Range("A2", .Cells(Rows.Count, "A").End(xlUp))
    End With
    vIn = ListRange.Value
    'Now go through each 'cell' of the array and check if empty
    For lRi = 1 To UBound(vIn, 1)
        If vIn(lRi, 1) <> "" Then
            lRl = lRl + 1
            ReDim Preserve vList(1 To lRl)  'add row to the array holding the list input, keeping any values already there
            'add the value from the input array to the list array
            vList(lRl) = vIn(lRi, 1)
        End If
    Next lRi

    'ListRowsMaximum is the original ListRows value - maximum number of displayed rows
   
    If ListRowsMaximum = 0 Then ListRowsMaximum = Me.ComboBox1.ListRows
   
End Sub


Private Sub ComboBox1_GotFocus()

    If ListRange Is Nothing Then Init_Settings
   
    'Initialise the combobox List with cell values from ListRange
   
    With Me.ComboBox1
        .List = vList
        .ListRows = Application.WorksheetFunction.Min(ListRowsMaximum, .ListCount)
        .Text = ""
    End With
   
End Sub


Private Sub ComboBox1_DropButtonClick()
   
    If ListRange Is Nothing Then Init_Settings
   
    With Me.ComboBox1
        .List = vList
        .ListRows = Application.WorksheetFunction.Min(ListRowsMaximum, .ListCount)
        .DropDown
    End With
   
End Sub


Private Sub ComboBox1_Change()

    Dim i As Long
   
    'Update the combobox List to only the items containing the current Text
   
    If Not IsArrow Then
        With Me.ComboBox1
            .List = vList
            If Len(.Text) Then
                For i = .ListCount - 1 To 0 Step -1
                    If InStr(1, .List(i), .Text, vbTextCompare) = 0 Then .RemoveItem i

                Next
            End If
            .DropDown
            .ListRows = Application.WorksheetFunction.Min(ListRowsMaximum, .ListCount)
        End With
    End If
   
End Sub


Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
       
    With Me.ComboBox1
        .ListRows = Application.WorksheetFunction.Min(ListRowsMaximum, .ListCount)
    End With
       
    IsArrow = (KeyCode = vbKeyUp) Or (KeyCode = vbKeyDown)
   
    If KeyCode = vbKeyReturn Then
        Me.ComboBox1.List = vList
    ElseIf KeyCode = vbKeyTab Then
        'Tab key selects first displayed item or highlighted item
        With Me.ComboBox1
            If .ListIndex = -1 Then
                .Value = .List(0)
            Else
                .Value = .List(.ListIndex)
            End If
        End With
        KeyCode = vbKeyReturn
    End If
   
End Sub

Hello sijpie, thank you so much for the solution, its almos perfect!
but i don't know why, sometimes i have error 381 on .List = vList

VBA Code:
Private Sub ComboBox1_Change()

    Dim i As Long
    
    'Update the combobox List to only the items containing the current Text
    
    If Not IsArrow Then
        With Me.ComboBox1
            .List = vList   '<--------------- I have error 381 on this line
            If Len(.Text) Then
                For i = .ListCount - 1 To 0 Step -1
                    If InStr(1, .List(i), .Text, vbTextCompare) = 0 Then .RemoveItem i

                Next
            End If
            .DropDown
            .ListRows = Application.WorksheetFunction.Min(ListRowsMaximum, .ListCount)
        End With
    End If
    
End Sub
 
Upvote 0
Try this, as I think for dom reason vList is empty.

VBA Code:
Private Sub ComboBox1_Change()

    Dim i As Long
    
    'Update the combobox List to only the items containing the current Text
    If not isarray(vList) then init_settings
    If Not IsArrow Then
        With Me.ComboBox1
            .List = vList   '<--------------- I have error 381 on this line
            If Len(.Text) Then
                For i = .ListCount - 1 To 0 Step -1
                    If InStr(1, .List(i), .Text, vbTextCompare) = 0 Then .RemoveItem i

                Next
            End If
            .DropDown
            .ListRows = Application.WorksheetFunction.Min(ListRowsMaximum, .ListCount)
        End With
    End If
    
End Sub
 
Upvote 0
Try this, as I think for dom reason vList is empty.

VBA Code:
Private Sub ComboBox1_Change()

    Dim i As Long
  
    'Update the combobox List to only the items containing the current Text
    If not isarray(vList) then init_settings
    If Not IsArrow Then
        With Me.ComboBox1
            .List = vList   '<--------------- I have error 381 on this line
            If Len(.Text) Then
                For i = .ListCount - 1 To 0 Step -1
                    If InStr(1, .List(i), .Text, vbTextCompare) = 0 Then .RemoveItem i

                Next
            End If
            .DropDown
            .ListRows = Application.WorksheetFunction.Min(ListRowsMaximum, .ListCount)
        End With
    End If
  
End Sub

Thank you sijpie, you are a savior!
I have a little visual bug, sometimes the listrow fills the entire screen and i have to set it back to 8 in properties form the combobox.

Can i abuse your help?

1- I have a textbox that inserts data in the combobox list, but it doesn't appear right in the listrow, I need to run the Private Sub init_Settings() that is in worksheet 3
for this module "4" to update this list right!?

2- I need to block a textbox activex that only accepts day, month and year. and that auto complete with "-" after I type the day and month.

Ex:
'I type "22" and the macro put "-"
22-
'and I keep typing 12 and the macro add the "-"
22-12-

Sorry if i'm abusing too much and thanks for your great help.
 
Upvote 0
For your bug:
The last line in Init_Settings:
VBA Code:
 If ListRowsMaximum = 0 Then ListRowsMaximum = 8
 
Upvote 0
1- I have a textbox that inserts data in the combobox list, but it doesn't appear right in the listrow, I need to run the Private Sub init_Settings() that is in worksheet 3
for this module "4" to update this list right!?
You can write the Textbox_Exit sub to call init_settings:
VBA Code:
Private Sub TextBox1_Change()
    Init_Settings
End Sub

2- I need to block a textbox activex that only accepts day, month and year. and that auto complete with "-" after I type the day and month.
You do this in the textbox_Change sub
The following is a bit crude, it doesn't catch somebody entering endless numbers for years, and it assumes the user knows to enter 04 and not 4. But maybe you can refine...
VBA Code:
Private Sub TextBox1_Change()
    Dim sR As String
    Dim iL As Integer
    
    iL = Len(TextBox1)
    If iL Then
        sR = Right(TextBox1.Value, 1)
        If (Not IsNumeric(sR)) And Not sR Like "-" Then
            TextBox1.Value = Left(TextBox1.Value, Len(iL) - 1)
        End If
    End If
    If iL = 2 Then TextBox1.Value = TextBox1.Value & "-"
    If iL = 5 Then TextBox1.Value = TextBox1.Value & "-20"
End Sub
 
Upvote 0
Man, you're a god, thanks a milion for for saving me and for the help with topics very different from the thread title.
 
Upvote 0

#sijpie​

My friend, I'm really sorry but I need your help with one more problem, if you can.

I use the code with your settings for some comboboxes and this new one also needs to have unique values.

VBA Code:
Private Sub Init_Settings()

    Dim lRi As Long, lRl As Long
    'vList will hold the values to use in the combobox List
    ReDim vList(1 To 1)
    
    'first read the data set into an array vIn. This is far quicker then looping through each cell
    With Worksheets("Estoque")
        Set ListRange = .Range("B2", .Cells(Rows.Count, "B").End(xlUp)) '[c3:c12]
    End With
    vIn = ListRange.Value
    'Now go through each 'cell' of the array and check if empty
    For lRi = 1 To UBound(vIn, 1)
        If vIn(lRi, 1) <> "" Then
            lRl = lRl + 1
            ReDim Preserve vList(1 To lRl)  'add row to the array holding the list input, keeping any values already there
            'add the value from the input array to the list array
            vList(lRl) = vIn(lRi, 1)
        End If
    Next lRi

    'ListRowsMaximum is the original ListRows value - maximum number of displayed rows
    
    If ListRowsMaximum = 0 Then ListRowsMaximum = 8

End Sub

I found this part in another thread about autocomplete i tried putting them together but failed again. would all the code have to be redone to work correctly?!
VBA Code:
For Each x In vList
              Make the list unique & has no blank
               If IsNumeric(x) Then x = CStr(x)
                If Not dar.Contains(x) And x <> Empty Then
                    dar.Add x
                End If


I can understand that the code you made for me, compares if the array is empty, but I can't imagine how to compare with a value already placed in the list.
Thanks again!
 
Upvote 0

Forum statistics

Threads
1,223,234
Messages
6,170,891
Members
452,366
Latest member
TePunaBloke

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