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.
 
You're right, the problem arise when there is word that is part of another word, like a, aa, aaa. I've amended the code to deal with that problem.
And also amended the code so every time you choose an item in the combobox it will be automatically sent to the activecell (without needing to press Enter)
Try this:

Try making this change:
in Private Sub ComboBox1_Change()
Change this line:
Call get_filterX
to:
Call get_filterY

and in Sub get_filterY()
Change this line:
If LCase(x) Like "*" & Replace(LCase(ComboBox1.Value), " ", "*") & "*" Then
to:
If LCase(x) Like Replace(LCase(ComboBox1.Value), " ", "*") & "*" Then
Dear Akuini,
Could you make it faster in the sheet has combobox. Because when I move in that sheet, it's delayed.
I'm your fan at the first code. Thank you
 
Upvote 0

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result
Could you make it faster in the sheet has combobox. Because when I move in that sheet, it's delayed.
1. I can't reproduce the delay behaviour. Are you saying it happened on my sample workbook or on your workbook?
2. Have you tried using the Search deList add-in instead? it's much easier if you use the add-in because you don't need to use macro, just set up data validation in your workbook. Also you'll get several more features. The latest version is Search deList v.2.1:
 
Upvote 0
1. I can't reproduce the delay behaviour. Are you saying it happened on my sample workbook or on your workbook?
2. Have you tried using the Search deList add-in instead? it's much easier if you use the add-in because you don't need to use macro, just set up data validation in your workbook. Also you'll get several more features. The latest version is Search deList v.2.1:
I tested on sample workbook, use an low computer configuration you can recognize it easier. On my workbook with lot of data row when move to other cell it delayed not smooth as other sheet without code.
if disable "Private Sub Worksheet_SelectionChange(ByVal Target As Range)" (to call combobox) it will smooth. I was tried insert code "Application.EnableEvents = False" after that "True" but nothing bettter.
 
Upvote 0
On my workbook with lot of data row when move to other cell it delayed not smooth as other sheet without code.
1. About how many rows is your data?
2. Do you need data in the combobox list to be sorted? I ask this this because the sorting part could slow down the process.
 
Upvote 0
1. About how many rows is your data?
2. Do you need data in the combobox list to be sorted? I ask this this because the sorting part could slow down the process.
Normal is 5000 rows and data is sorted or unsorted is not important which more smooth is better.
Although I dont turn on combobox and move to whatever cell, its be delayed
 
Upvote 0
Although I dont turn on combobox and move to whatever cell, its be delayed
If you turn off the combobox & it's still delayed then problem should be elsewhere.
Could you show me the code in "Private Sub Worksheet_SelectionChange"?
 
Upvote 0
If you turn off the combobox & it's still delayed then problem should be elsewhere.
Could you show me the code in "Private Sub Worksheet_SelectionChange"?
OK, all code is yours form first time

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' if selection is in a certain range (xCell) then Call toShowCombobox
If Not Intersect(Range("K9:K" & Range("CuoiNKC").Row - 1), 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

Full code:
Sub toOnOffVAT()
xFlag = Not xFlag
If xFlag = False Then
If ComboBox1.Visible = True Then ComboBox1.Visible = False
End If
ActiveCell.Offset(0, ofs).Activate
End Sub
Private Sub ComboBox1_GotFocus()
'Chr(150) is a unique dash character "–" to separate the entries
xSep = " " & Chr(150) & " "

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

Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim vlist2, va, i As Long, j As Long, z
Select Case KeyCode
Case 13 'Enter
va = Sheets(sList).Range(sCell, Sheets(sList).Cells(Rows.Count, sCol).End(xlUp)).Resize(, nc).value
ReDim vlist2(1 To UBound(va, 1), 1 To 1)
For i = 1 To UBound(va, 1)
vlist2(i, 1) = va(i, 1) & xSep & va(i, 2) & xSep & va(i, 5) '& xSep & va(i, 4) & xSep & va(i, 5)
Next

'Enter Key to fill the cell with combobox value
If IsError(Application.Match(ComboBox1.value, vlist2, 0)) Then
If Len(ComboBox1.value) = 0 Then
ActiveCell.Resize(, nc) = ""
ActiveCell.Offset(1, ofs).Activate
Else
' ''Neu du lieu moi se ngung
'MsgBox "Wrong input", vbCritical
'Neu du lieu moi thi tiep tuc
With ComboBox1
j = 0
For Each z In Split(.value, xSep)
ActiveCell.Offset(, j) = z
j = j + 1
Next
ActiveCell.Offset(1, ofs).Activate
End With
End If
Else

With ComboBox1
j = 0
For Each z In Split(.value, xSep)
ActiveCell.Offset(, j) = z
j = j + 1
Next
ActiveCell.Offset(1, ofs).Activate
End With

End If
Case 27, 9 'esc 'tab
ComboBox1.Clear
ActiveCell.Offset(1, 0).Activate

Case 37 'nhan mui ten qua trai
ComboBox1.Clear
ActiveCell.Offset(0, -1).Activate

Case 39 'nhan mui ten qua phai
ComboBox1.Clear
ActiveCell.Offset(0, 1).Activate

Case Else
'do nothing
End Select

End Sub

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Application.ScreenUpdating = False
Dim strName As String
Select Case KeyCode
Case 13
strName = ActiveSheet.TextBox1.value
If Not strName = "" Then
With ActiveSheet.Range("A8:S" & Range("CuoiNKC").Row - 1)
.AutoFilter
.AutoFilter Field:=3, Criteria1:="*" & strName & "*"
End With
Else
On Error Resume Next
ActiveSheet.ShowAllData
End If
Range("C7").Select
Case 37
Range("B6").Select
Case 38
Range("C5").Select
Case 39
Range("D6").Select
Case 40
Range("C7").Select
Case 27, 9
ActiveSheet.TextBox1.value = ""
On Error Resume Next
ActiveSheet.ShowAllData
End Select
Application.ScreenUpdating = True
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("K9:K" & Range("CuoiNKC").Row - 1), 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("K9:K" & Range("CuoiNKC").Row - 1), Target) Is Nothing And Target.CountLarge = 1 Then

'setting up combobox property
With ComboBox1
.Height = Target.Height + 3 '5
.Width = Target.Resize(, nc).Width + 10 '10
.Top = Target.Top - 2
.Left = Target.Offset(0, 0).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, va, i As Long
va = Sheets(sList).Range(sCell, Sheets(sList).Cells(Rows.Count, sCol).End(xlUp)).Resize(, nc).value
ReDim vlist2(1 To UBound(va, 1), 1 To 1)
For i = 1 To UBound(va, 1)
vlist2(i, 1) = va(i, 1) & xSep & va(i, 2) & xSep & va(i, 5) '& xSep & va(i, 4) & xSep & va(i, 5)
Next


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, va, dar As Object, i As Long
With ComboBox1
If .value = vbNullString Then

va = Sheets(sList).Range(sCell, Sheets(sList).Cells(Rows.Count, sCol).End(xlUp)).Resize(, nc).value
ReDim vList(1 To UBound(va, 1), 1 To 1)
For i = 1 To UBound(va, 1)
vList(i, 1) = va(i, 1) & xSep & va(i, 2) & xSep & va(i, 5) '& xSep & va(i, 4) & xSep & va(i, 5)
Next

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
@kobebryant
Could you upload your workbook (without sensitive data) to a sharing site like dropbox.com or google drive?
And then share the link here.
 
Upvote 0
@kobebryant
Could you upload your workbook (without sensitive data) to a sharing site like dropbox.com or google drive?
And then share the link here.
Oh, I have checked my file, it's just delayed a little bit, may be my computer has problem.
Thank you so much.
 
Upvote 0

Forum statistics

Threads
1,214,424
Messages
6,119,407
Members
448,894
Latest member
spenstar

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