Searchable drop down entirely in VBA?

MarCylinder · Jul 31st 2018

I'm attempting to build a searchable drop down menu without using any helper columns. I have tried going about this myself, but cannot find a way to do this without using a helper column.

I have a workbook with two sheets. The dropdown is on Sheet 1, and it is propagated with data from a column in Sheet 2. For reasons I won't go into, I cannot make any changes to Sheet 2. I currently have a Worksheet_SelectionChange function that autocompletes the dropdown when the user types in it. I was hoping to cleanly swap out this function with one that presents the user with search results instead. I'm still a novice with VBA. I understand if nobody wants to write the function, but if you could point me in the right direction, I'd really appreciate it. Really, any help at all would be great.

FWIW, the autocomplete function I am using is below:

Code

Private Sub Worksheet_SelectionChange(ByVal Target As Range)


    Dim xCombox As OLEObject
    Dim xStr As String
    Dim xWs As Worksheet
        
    Set xWs = Application.ActiveSheet
    
    On Error Resume Next
    
    Set xCombox = xWs.OLEObjects("TempCombo")
    With xCombox
        .ListFillRange = ""
        .LinkedCell = ""
        .Visible = False
    End With
    
    If Target.Validation.Type = 3 Then
        Target.Validation.InCellDropdown = False
        Cancel = True
        xStr = Target.Validation.Formula1
        xStr = Right(xStr, Len(xStr) - 1)
        If xStr = "" Then Exit Sub
        With xCombox
            .Visible = True
            .Left = Target.Left
            .Top = Target.Top
            .Width = Target.Width + 5
            .Height = Target.Height + 5
            .ListFillRange = xStr
            .LinkedCell = Target.Address
        End With
        xCombox.Activate
        Me.TempCombo.DropDown
    End If
       
End Sub

Display More

**Carim** · Aug 1st 2018

Hello,

Your objective can be quite challenging ... depending on the various features you are aiming at ...:wink:

Could you attach your sample file ...

Cheers

MarCylinder · Aug 1st 2018

Absolutely. The file is attached to this post. Let me know if there are any questions.

**Carim** · Aug 1st 2018

Hello,

Will take a look at your file ... and get back to you asap with a proposal ...:wink:

P.S. Could you quickly describe the way you want to use your form ... and the expected result

MarCylinder · Aug 2nd 2018

I would like to be able to search for the data that is propagated in the dropdown that appears in cells C9 and D9.

I would like to emulate the behavior seen in tutorials like this one:
http://www.computergaga.com/bl…oogle-search-excel-trick/

However, I need to do it without the use of helper columns.

Selecting data in the dropdown will pull relevant information from the list the appears on the second sheet. Clicking the button will add the selected data to the list. At this time the entire spreadsheet functions as intended. However, the autocomplete function is less useful in practice than I had hoped. A search function would be far more useful.

**Carim** · Aug 3rd 2018

Hello Marc,

Attached is a test file with a proposal to adapt to (and test with ) your actual data ...

The autocomplete feature is coupled with the 'google-type-search' you are looking for ... :wink:

Hope this will help

MarCylinder · Aug 3rd 2018

Hey Carim! Thank you very much. When I begin to type, I am not seeing a list of search suggestions in the dropdown. However, I am seeing the corresponding values in the neighboring cells change as I type, which is pretty cool. Another strange thing I noticed is that the value in the dropdown is copied to any cell I click on after changing the value. I'm going to sit down and play with the code to see if I can understand it. Let me know if you have any suggestions on what I can do. Again, thank you very much for your help!

**Carim** · Aug 3rd 2018

Hello,

Thanks for your Thanks ...AND for the Like ...:smile:

At my end, the quick test I did was fine ...

Just test the code with your actual data ...and let me know the outcome ...

MarCylinder · Aug 3rd 2018

Hi Carim. No luck still, however I found that this section of code

Code

Private Sub ComboBox1_LostFocus()
  ActiveCell.Value = Me.ComboBox1
  Me.ComboBox1.Visible = False
End Sub

Is causing whatever cell is selected to be given the value in the combo box. I encountered a similar issue when first putting this together and came up with a workaround.

However, I cannot figure out why the dropdown from the combobox is still not filtering the results. I can tell it's working because the other values change while I type. The dropdown is the only thing that doesn't seem to want to update. I'm still in a little over my head, but I'm learning a lot. I had no clue about collections or dictionaries.

**Carim** · Aug 3rd 2018

Hi Marc,

You should be testing the code with actual data ... to get the filtering working ... see attached version 2 ...

HTH

MarCylinder · Aug 3rd 2018

It worked this time! Very very cool.

I did test this with both the test data and my real data. There is one change I want to try to make. I'll try to explain this in a clear way.

Let's say I have a list of names in the column we're pulling data from. Something like:
Matt Johnson
Steve Johnson
Craig Hall
Matt Smith
Sarah Johnson

In its current form, if I type "Johnson" in the combobox, it will return 0 results. If I type "Matt" it will return two results. Ideally, typing "Johnson" should return every item that contains "Johnson" as part of the name, just as it would when I type "Matt". How would you adjust the code to accomplish that?

**Carim** · Aug 3rd 2018

Glad to hear the code is working fine ...:wink:

As soon as I have a moment ... I will take a look into your latest query ...:smile:

As an initial test ... you could use the following update procedure :

Code

Private Sub ComboBox1_Change()
Dim dic
Dim tmp As String
Dim c As Variant


  If Me.ComboBox1 <> "" And IsError(Application.Match(Me.ComboBox1, lis, 0)) Then
    Set dic = CreateObject("Scripting.Dictionary")
    tmp = "*" & UCase(Me.ComboBox1) & "*"
    For Each c In lis
      If UCase(c) Like tmp Then dic(c) = ""
    Next c
    Me.ComboBox1.List = dic.keys
    Me.ComboBox1.DropDown
  End If
  ActiveCell.Value = Me.ComboBox1
End Sub

Display More

Hope this will help

MarCylinder · Aug 6th 2018

That worked perfectly! This is really really cool. Seriously, thank you so much.

**Carim** · Aug 6th 2018

Quote from MarCylinder

That worked perfectly! This is really really cool. Seriously, thank you so much.

Very glad to hear you that you have managed to achieve your objective ...:wink:

Thanks a lot ... for your Thanks ..AND also for the Like ...:smile:

din2din · Jan 10th 2020

Carim: I am trying to create the exact above solution, but in a userform instead of a cell. In the attached file, sheet "Orders" has a userform button. In the form, the box "Item" is a combo box. I would like that box to be searchable. It is referencing data from the named range "Items" from the sheet "Catalog". I used your code above and changed it according to my data, but I am getting errors. Could you take a look please? It would be greatly appreciated.

Thanks

dinesh

**Carim** · Jan 10th 2020

Hello,

As soon as I have a moment, will take a look at your project ...

**Carim** · Jan 10th 2020

Hello,

Had a quick look at your workbook ... but you have not yet started to Initialize your UserForm ... !!!

and copying worksheet events into the UserForm module will produce absolutely nothing ...!!!

You should start your own thread to get going with a basic UserForm ...

then you will worry about searchable comboboxes ...

Kawalzki · Feb 14th 2020

Hi Carim

I Have been working with the Code that you supplied the Orriginal Poster and the document that you gave to him works perfectly but when i implemented it into my own Workbook and Modified the Name it breaks consistantly at

( If Me.CmbLocation <> "" And IsError(Application.Match(Me.CmbLocation, lis, 0)) Then )

giving me error message " Run-time error '5': Invalid Procedure call or Argument. i verified my reference libraries matched the previous tool and

Never Mind as i was typing this message i came accross the fact that i didnt Set the Combo Box to hidden in the initial Test run Causing it to miss out on some key initialization Features in the Worksheet_SelectionChange but now this tool runs amazingly! Thanks so much for the Great Code! it will help me with everything i needed!!!

Kawalzki · Feb 14th 2020

Sorry this would not let me edit my previous post so here is additional information

Hi Carim

I Have been working with the Code that you supplied the Orriginal Poster and the document that you gave to him works perfectly but when i implemented it into my own Workbook and Modified the Name it breaks consistantly at

( If Me.CmbLocation <> "" And IsError(Application.Match(Me.CmbLocation, lis, 0)) Then )

giving me error message " Run-time error '5': Invalid Procedure call or Argument. i verified my reference libraries matched the previous tool and

Never Mind as i was typing this message i came accross the fact that i didnt Set the Combo Box to hidden in the initial Test run Causing it to miss out on some key initialization Features in the Worksheet_SelectionChange but now this tool runs amazingly! Thanks so much for the Great Code! it will help me with everything i needed!!!

Please Review the code i made a few minor tweeks and would love for it to be available to everyone in the future! i did Tweek the Private Sub CmbLocation_LostFocus, i ran into the same concern as the OP, i changed it to

Private Sub CmbLocation_LostFocus()

Main.Range("C14").Value = Me.CmbLocation

Me.CmbLocation.Visible = False

End Sub

Which clears up the tool automaticly copying what was in the Combo box into the previously selected cell

Code

'*****************
'Eddited 02/14/20
'by Kawalzki
'Written 07/03/18
'by Carim
'*****************

Private Sub Worksheet_SelectionChange(ByVal Target As Range)  If Intersect(Target, Range("C14")) Is Nothing Then  Exit Sub  End If  Dim zInput As Range    If Target.CountLarge > 1 Then Exit Sub  Set ws = Locations  Set zInput = Range("C14")  If Not Intersect(zInput, Target) Is Nothing And Target.Count = 1 Then    If memo <> "" Then If IsError(Application.Match(Range(memo), lis, 0)) Then Range(memo) = ""    lis = Application.Transpose(ws.Range("A2:A" & ws.[C65000].End(xlUp).Row))    Me.CmbLocation.List = lis    Me.CmbLocation.Height = Target.Height + 3    Me.CmbLocation.Width = Target.Width    Me.CmbLocation.Top = Target.Top    Me.CmbLocation.Left = Target.Left    Me.CmbLocation = Target    Me.CmbLocation.Visible = True    Me.CmbLocation.Activate    memo = Target.Address  Else    Me.CmbLocation.Visible = False  End If
End Sub

Private Sub CmbLocation_Change()
Dim dic
Dim tmp As String
Dim c As Variant
  If Me.CmbLocation <> "" And IsError(Application.Match(Me.CmbLocation, lis, 0)) Then    Set dic = CreateObject("Scripting.Dictionary")    tmp = UCase(Me.CmbLocation) & "*"    For Each c In lis      If UCase(c) Like tmp Then dic(c) = ""    Next c    Me.CmbLocation.List = dic.keys    Me.CmbLocation.DropDown  End If  ActiveCell.Value = Me.CmbLocation
End Sub

Private Sub CmbLocation_DblClick(ByVal Cancel As MSForms.ReturnBoolean)  CmbLocation.List = Application.Transpose(ws.Range("A2:A" & ws.[C65000].End(xlUp).Row))  Me.CmbLocation.DropDown
End Sub

Private Sub CmbLocation_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)  If KeyCode = 13 Then    If IsError(Application.Match(ActiveCell, lis, 0)) Then ActiveCell = ""    ActiveCell.Select    'ActiveCell.Offset(1).Select  End If
End Sub

Private Sub CmbLocation_LostFocus()  Main.Range("C14").Value = Me.CmbLocation  Me.CmbLocation.Visible = False
End Sub

Display More

davesexcel · Feb 16th 2020

Quote from Kawalzki

Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Intersect(Target, Range("C14")) Is Nothing Then Exit Sub End If Dim zInput As Range If Target.CountLarge > 1 Then Exit Sub Set ws = Locations Set zInput = Range("C14") If Not Intersect(zInput, Target) Is Nothing And Target.Count = 1 Then If memo <> "" Then If IsError(Application.Match(Range(memo), lis, 0)) Then Range(memo) = "" lis = Application.Transpose(ws.Range("A2:A" & ws.[C65000].End(xlUp).Row)) Me.CmbLocation.List = lis Me.CmbLocation.Height = Target.Height + 3 Me.CmbLocation.Width = Target.Width Me.CmbLocation.Top = Target.Top Me.CmbLocation.Left = Target.Left Me.CmbLocation = Target Me.CmbLocation.Visible = True Me.CmbLocation.Activate memo = Target.Address Else Me.CmbLocation.Visible = False End If
End Sub

This does not belong in the UserForm module.

Searchable drop down entirely in VBA?

Participate now!

Share