Best way to create a searchable drop-down list with auto-complete functionality to cells in a column?

dougmarkham

Active Member
Joined
Jul 19, 2016
Messages
252
Office Version
  1. 365
Platform
  1. Windows
Hi Folks,

I have a time-sheet workbook with two worksheets (ws). In sheet 1 (the time-sheet ws), Column A is "Employee".

Time-sheet worksheet.
EmployeeStart timeFinish timeHours worked
Joe Blogs
Jane Doe

<tbody>
</tbody>





I wish to be able to start typing a different employee on each row of column A (these employees are temporary workers) and have a drop-down offer me matching results to select.
Worksheet 2 is a master list of temporary employee names on.
Employee List
Joe Blogs
Jane Doe
Andrew Peters
Sarah Cook
Joseph Belkin

<tbody>
</tbody>










Goal:
a) I envision the user to be able to start typing an employee name,
b) ...as the user is typing, I would like excel to search the master list and offer a set of matching names (a list which shrinks as the user types).
c) I would like the user to be able to select the correct employee name and have that name populate the cell (i.e., to use the down arrow key to select the desired option and press the enter key to populate the cell).

What I've already found from searches:
*There are multiple options to create an ActiveX text box for creating a searchable drop-down; however, these don't offer any way of making every cell in a column of a table to become a searchable-drop-down.
*I've found a few methods using formulas: they tend to offer only the option to click on the drop-down arrow, rather than drop-down list as you type. I'm trying to get away from options which cause the user's hands to leave the keyboard to operate a mouse.

The end goal would be to facilitate the above for existing temporary employees; however, if the employee is a new worker, I am looking to use VBA to transfer the new name from the a cell in column A to the master list via clicking a form control button.

Would anybody be willing to help me find a viable way to do this?

Due to restrictions, I don't think I'll be able to install any add-ins: just VBA, userforms and formulas.

Kind regards,

Doug.
 
So is it possible the cursor to go to the below cell after leaving the combobox go to the below cell and not to the next one?
In "Private Sub ComboBox1_KeyDown", change this part:
ActiveCell.Offset(, ofs).Activate
to this:
ActiveCell.Offset(ofs).Activate

There are 2 lines with ActiveCell.Offset(, ofs).Activate, change both of them.
 
Upvote 0

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.
In "Private Sub ComboBox1_KeyDown", change this part:
ActiveCell.Offset(, ofs).Activate
to this:
ActiveCell.Offset(ofs).Activate

There are 2 lines with ActiveCell.Offset(, ofs).Activate, change both of them.
Ok now it's perfect to my needs. I'm grateful for your help.
 
Upvote 0
You're welcome, glad to help, & thanks for the feedback.:)
 
Upvote 0
You're welcome, glad to help, & thanks for the feedback.:)
Hello again. Now i realize a problem in the cells that the combobox appears. I can not insert a note or a comment to these cells (obviously because when i make right click it appears the combobox).
Is there any solution in that? Thanks in advance.
 
Upvote 0
I need to fix something about the the searchable combobox in the sample workbook in post#2.
I just realized that in sheet1 & sheet2 if you select a cell (anycell) then it will erase the Undo List, it means that you can't use Undo. So you need to replace this line (in 2 places, i.e: Private Sub Worksheet_SelectionChange & Sub toShowCombobox()):
ComboBox1.Visible = False
with this:
If ComboBox1.Visible = True Then ComboBox1.Visible = False

Now when you select a cell the Undo List will be preserved. But not in the range with the combobox, because selecting a cell in that range will trigger the macro to change something, i.e showing the combobox. Unfortunately, when something is changed by macro then it will erase the Undo List.

So if anyone here has implemented the searchable combobox using the code in the sample workbook then you might need to change the code accordingly.

I deleted the sample file in question (the link is in post #2) in my mediafire account, and here's a new link (with amended code) in case anyone needs it:

Another thing:
If you're interested in implementing the searchable combobox in your workbook, here's how to do it:
-On your workbook, create an activex combobox (its name should be ComboBox1) in the sheet where you want to enter data with the combobox (say "sheet1"), you can put it anywhere.
-Put the list (as the source of the combobox) in another sheet col A.
-Copy the macro in sheet1 in the sample workbook.
-Back to your workbook, right click the sheet1 name tab and choose "View Code" then paste the macro.
-You need to adjust some part of the code in this part:
'=============== YOU MAY NEED TO ADJUST THE CODE IN THIS PART: ===================================
 
Upvote 0
Hello again. Now i realize a problem in the cells that the combobox appears. I can not insert a note or a comment to these cells (obviously because when i make right click it appears the combobox).
Is there any solution in that? Thanks in advance.
You might want to try the searchable combobox in sheet2 in the sample workbook above. This searchable combobox is a bit different from the one in sheet1. Here you can turn the combobox on and off. So if you don’t want the combobox to be activated then just click the ON-OFF button and then click it again to turn it back on.
 
Upvote 0
You might want to try the searchable combobox in sheet2 in the sample workbook above. This searchable combobox is a bit different from the one in sheet1. Here you can turn the combobox on and off. So if you don’t want the combobox to be activated then just click the ON-OFF button and then click it again to turn it back on.
Ok i tried to bring the code with the on off button to my needs, but i cannot make it work. The combobox is always enabled (even if i press the on/off button). Can you please the code to tell me what's wrong?
Thanks in advanced.
VBA Code:
'=============== YOU MAY NEED TO ADJUST THE CODE IN THIS PART: ===================================

'sheet's name where the list (for combobox) is located. [in the sample: sheet "deList"]
Private Const sList As String = "LISTS"

'row where the list start [in the sample: row 2 in sheet "deList" ]
Private Const rCell As Long = 2

'range where you want to use the combobox
Private Const xCell As String = "C5:C11466,E5:E11466,F5:F11466,G5:G11466"

'offset from xCell (the blue area) where the cursor go after leaving the combobox
' 1 means 1 column to the right of xCell
Private Const ofs As Long = 1

'================================================================================================
Private ary
Private arz


'=================================================================================================

Private Sub ComboBox1_GotFocus()
With ComboBox1
.MatchEntry = fmMatchEntryNone
.Value = ""
End With

'ADJUST THE CODE IN THIS PART:
'you can have different number of columns
ary = Split("C,E,F,G", ",")  ' columns where the combobox is located
arz = Split("F,C,A,B", ",")  ' columns where the list as the source of the combobox is located

End Sub
Sub toOnOff()
xFlag = Not xFlag
    If xFlag = False Then
    If ComboBox1.Visible = True Then ComboBox1.Visible = False
    End If
ActiveCell.Offset(ofs).Activate
End Sub
Private Sub CommandButton1_Click()
Call toOnOff
End Sub
Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
        Select Case KeyCode
        Case 13 'Enter
           'Enter Key to fill the cell with combobox value

            Dim x As String, fm, vList2
                
                With Sheets(sList)
                    x = Split(ActiveCell.Address, "$")(1)
                    fm = Application.Match(x, ary, 0) - 1
                    x = arz(fm)
                    vList2 = .Range(.Cells(rCell, x), .Cells(Rows.Count, x).End(xlUp)).Value
                End With
            
            If IsError(Application.Match(ComboBox1.Value, vList2, 0)) Then
                
                If Len(ComboBox1.Value) = 0 Then
                    ActiveCell = ""
                    Else
                    MsgBox "Wrong input", vbCritical
                End If
            Else
                ActiveCell = ComboBox1.Value
                ActiveCell.Offset(ofs).Activate
            End If
        
        Case 27, 9 'esc 'tab
                ComboBox1.Clear
                ActiveCell.Offset(ofs).Activate
        Case Else
            'do nothing
    End Select

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' if selection is in a certain range (xCell) then Call toShowCombobox
 If Not Intersect(Range(xCell), Target) Is Nothing And Target.CountLarge = 1 Then
    Call toShowCombobox
      Else
    ComboBox1.Visible = False
End If

End Sub


Sub toShowCombobox()

Dim Target As Range

Set Target = ActiveCell
' if selection is in a certain range (xCell) then show combobox
 If Not Intersect(Range(xCell), Target) Is Nothing And Target.CountLarge = 1 Then
        
 'setting up combobox property
        With ComboBox1
        .Height = Target.Height + 5
        .Width = Target.Width + 10
        .Top = Target.Top - 2
        '.Left = Target.Offset(0, 1).Left
        .Left = Target.Left
        .Visible = True
        .Value = ""
        .Activate
        
        End With
  Else
    ComboBox1.Visible = False
  End If

End Sub

Private Sub ComboBox1_LostFocus()
'    If selection is still in this sheet
    If Selection.Worksheet.Name = Me.Name Then
        
        Call toShowCombobox
        
    End If
End Sub




''========================= using "System.Collections.ArrayList" to sort list ========================
Private Sub ComboBox1_Change()

Dim dar As Object, vList2, i As Long
Dim x As String, fm

With Sheets(sList)
    x = Split(ActiveCell.Address, "$")(1)
    fm = Application.Match(x, ary, 0) - 1
    x = arz(fm)
    vList2 = .Range(.Cells(rCell, x), .Cells(Rows.Count, x).End(xlUp)).Value
End With

With ComboBox1
If .Value <> "" And IsError(Application.Match(.Value, vList2, 0)) Then
    Set dar = CreateObject("System.Collections.ArrayList")
    For i = LBound(vList2) To UBound(vList2)

         'Use this for search patern: word*word*
'        If LCase(vList2(i, 1)) Like Replace(LCase(.Value), " ", "*") & "*" Then
        
        'Use this for search patern: *word*word*
        If LCase(vList2(i, 1)) Like "*" & Replace(LCase(.Value), " ", "*") & "*" Then
                If Not dar.Contains(vList2(i, 1)) And vList2(i, 1) <> "" Then
                    dar.Add vList2(i, 1)
                End If
        End If
    Next
        dar.Sort
       .List = dar.Toarray()
       .DropDown
End If
End With
End Sub

Private Sub ComboBox1_DropButtonClick()
Dim vList, dar As Object, i As Long
    With ComboBox1
        If .Value = vbNullString Then
        Dim x As String, fm
            With Sheets(sList)
                x = Split(ActiveCell.Address, "$")(1)
                fm = Application.Match(x, ary, 0) - 1
                x = arz(fm)
                vList = .Range(.Cells(rCell, x), .Cells(Rows.Count, x).End(xlUp)).Value
            End With
'        vList = Sheets(sList).Range(sCell, Sheets(sList).Cells(Rows.Count, sCol).End(xlUp)).Value
                
            
            Set dar = CreateObject("System.Collections.ArrayList")
  
            For i = LBound(vList) To UBound(vList)
                'make the list unique & has no blank
                If Not dar.Contains(vList(i, 1)) And vList(i, 1) <> "" Then
                    dar.Add vList(i, 1)
'                    dar.Add CStr(vList(i, 1))
                End If

            Next
            'sort the list
                dar.Sort
               .List = dar.Toarray()
               .DropDown

        End If
    End With
End Sub
 
Last edited:
Upvote 0
Try this:
BOOK_2020 - 2.xlsm

VBA Code:
'=============== YOU MAY NEED TO ADJUST THE CODE IN THIS PART: ===================================

'sheet's name where the list (for combobox) is located. [in the sample: sheet "deList"]
Private Const sList As String = "LISTS"

'row where the list start [in the sample: row 2 in sheet "deList" ]
Private Const rCell As Long = 2

'range where you want to use the combobox
Private Const xCell As String = "C3:C20000,E3:E20000,F3:F20000,G3:G20000"

'offset from xCell (the blue area) where the cursor go after leaving the combobox
' 1 means 1 column to the right of xCell
Private Const ofs As Long = 1

'================================================================================================
Private ary
Private arz


Private xFlag As Boolean
'=================================================================================================
Sub toOnOff()
xFlag = Not xFlag
    If xFlag = False Then
    If ComboBox1.Visible = True Then ComboBox1.Visible = False
    End If
ActiveCell.Offset(ofs).Activate
End Sub

Private Sub CommandButton1_Click()
Call toOnOff
End Sub

Private Sub ComboBox1_GotFocus()

With ComboBox1
.MatchEntry = fmMatchEntryNone
.Value = ""
    If xFlag = False Then
        .Visible = False
        ActiveCell.Activate
    End If
End With

'ADJUST THE CODE IN THIS PART:
'you can have different number of columns
ary = Split("C,E,F,G", ",")  ' columns where the combobox is located
arz = Split("F,C,A,B", ",")  ' columns where the list as the source of the combobox is located

End Sub

Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
        Select Case KeyCode
        Case 13 'Enter
           'Enter Key to fill the cell with combobox value

            Dim x As String, fm, vlist2
                
                With Sheets(sList)
                    x = Split(ActiveCell.Address, "$")(1)
                    fm = Application.Match(x, ary, 0) - 1
                    x = arz(fm)
                    vlist2 = .Range(.Cells(rCell, x), .Cells(Rows.Count, x).End(xlUp)).Value
                End With
            
            If IsError(Application.Match(ComboBox1.Value, vlist2, 0)) Then
                
                If Len(ComboBox1.Value) = 0 Then
                    ActiveCell = ""
                    Else
                    MsgBox "Wrong input", vbCritical
                End If
            Else
                ActiveCell = ComboBox1.Value
                ActiveCell.Offset(ofs).Activate
            End If
        
        Case 27, 9 'esc 'tab
                ComboBox1.Clear
'                ActiveCell.Offset(, ofs).Activate
                ActiveCell.Offset(ofs).Activate
        Case Else
            'do nothing
    End Select

End Sub



Private Sub Worksheet_SelectionChange(ByVal Target As Range)

' if selection is in a certain range (xCell) then Call toShowCombobox
If Not Intersect(Range(xCell), Target) Is Nothing And Target.CountLarge = 1 And xFlag = True Then
    Call toShowCombobox
      Else
'    ComboBox1.Visible = False
    If ComboBox1.Visible = True Then ComboBox1.Visible = False
End If
End Sub


Sub toShowCombobox()

Dim Target As Range

If xFlag = False Then Exit Sub
 
Set Target = ActiveCell
' if selection is in a certain range (xCell) then show combobox
 If Not Intersect(Range(xCell), Target) Is Nothing And Target.CountLarge = 1 Then
        
 'setting up combobox property
        With ComboBox1
        .Height = Target.Height + 5
        .Width = Target.Width + 10
        .Top = Target.Top - 2
        '.Left = Target.Offset(0, 1).Left
        .Left = Target.Left
        .Visible = True
        .Value = ""
        .Activate
        
        End With
  Else
    If ComboBox1.Visible = True Then ComboBox1.Visible = False
  End If

End Sub

Private Sub ComboBox1_LostFocus()
'    If selection is still in this sheet
    If Selection.Worksheet.Name = Me.Name Then
        
        Call toShowCombobox
        
    End If
End Sub




''========================= using "System.Collections.ArrayList" to sort list ========================
Private Sub ComboBox1_Change()

Dim dar As Object, vlist2, i As Long
Dim x As String, fm

With Sheets(sList)
    x = Split(ActiveCell.Address, "$")(1)
    fm = Application.Match(x, ary, 0) - 1
    x = arz(fm)
    vlist2 = .Range(.Cells(rCell, x), .Cells(Rows.Count, x).End(xlUp)).Value
End With

With ComboBox1
If .Value <> "" And IsError(Application.Match(.Value, vlist2, 0)) Then
    Set dar = CreateObject("System.Collections.ArrayList")
    For i = LBound(vlist2) To UBound(vlist2)

         'Use this for search patern: word*word*
'        If LCase(vList2(i, 1)) Like Replace(LCase(.Value), " ", "*") & "*" Then
        
        'Use this for search patern: *word*word*
        If LCase(vlist2(i, 1)) Like "*" & Replace(LCase(.Value), " ", "*") & "*" Then
                If Not dar.Contains(vlist2(i, 1)) And vlist2(i, 1) <> "" Then
                    dar.Add vlist2(i, 1)
                End If
        End If
    Next
        dar.Sort
       .List = dar.Toarray()
       .DropDown
End If
End With
End Sub

Private Sub ComboBox1_DropButtonClick()
Dim vList, dar As Object, i As Long
    With ComboBox1
        If .Value = vbNullString Then
        Dim x As String, fm
            With Sheets(sList)
                x = Split(ActiveCell.Address, "$")(1)
                fm = Application.Match(x, ary, 0) - 1
                x = arz(fm)
                vList = .Range(.Cells(rCell, x), .Cells(Rows.Count, x).End(xlUp)).Value
            End With
'        vList = Sheets(sList).Range(sCell, Sheets(sList).Cells(Rows.Count, sCol).End(xlUp)).Value
                
            
            Set dar = CreateObject("System.Collections.ArrayList")
  
            For i = LBound(vList) To UBound(vList)
                'make the list unique & has no blank
                If Not dar.Contains(vList(i, 1)) And vList(i, 1) <> "" Then
                    dar.Add vList(i, 1)
'                    dar.Add CStr(vList(i, 1))
                End If

            Next
            'sort the list
                dar.Sort
               .List = dar.Toarray()
               .DropDown

        End If
    End With
End Sub
 
Upvote 0

Forum statistics

Threads
1,215,036
Messages
6,122,796
Members
449,095
Latest member
m_smith_solihull

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