Macro to create searchable data validation+combobox

[Akuini]

Your test file doesn't use my code!.
Just remove the code & replace it with my code.

Dropbox

www.dropbox.com

 

[mercer31]

Your test file doesn't use my code!.
Just remove the code & replace it with my code.

Dropbox

www.dropbox.com

Can you post your code in the thread? For some reason it’s not showing up when I download your file.

 

[mercer31]

This is the exact code used in my file. I directly copied it from the code you had posted, unless something is somehow changing when I downloaded your file.

Option Explicit
'=================================================================================================
'=============== ADJUST THE CODE IN THIS PART: ===================================

'where the cursor go after leaving the combobox
' ofs1 As Long = 1 means 1 row below
' ofs2 As Long = 1 means 1 column to the right
Private Const ofs1 As Long = 0
Private Const ofs2 As Long = 1

' NOTE: you might adjust combobox property in Sub toShowCombobox()

'-------- Do not change this part --------------
Private vList
Private nFlag As Boolean
Private xFlag As Boolean
Private d As Object
Private oldVal As String

Private Sub CommandButton1_Click()
xFlag = Not xFlag
If xFlag = False Then
If ComboBox1.Visible = True Then ComboBox1.Visible = False
End If
ActiveCell.Offset(ofs1, ofs2).Activate
Application.EnableEvents = True
End Sub


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If ComboBox1.Visible = True Then ComboBox1.Visible = False

If Target.Cells.CountLarge = 1 And xFlag = False Then
'if activecell has data validation type 3
If isValid(Target) Then Call toShowCombobox: Cancel = True
End If

End Sub

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

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If ComboBox1.Visible = True Then ComboBox1.Visible = False: vList = Empty

End Sub

Function isValid(f As Range) As Boolean
Dim v
On Error Resume Next
v = f.Validation.Type
On Error GoTo 0
isValid = v = 3
End Function

Private Sub ComboBox1_GotFocus()
Dim dar As Object, x

With ComboBox1
.MatchEntry = fmMatchEntryNone
.Value = ""

Set dar = CreateObject("System.Collections.ArrayList")
Set d = CreateObject("scripting.dictionary"): d.CompareMode = vbTextCompare

vList = Evaluate(ActiveCell.Validation.Formula1)
If IsError(vList) Then GoTo skip
For Each x In vList
d(CStr(x)) = Empty
Next
If d.Exists("") Then d.Remove ""

For Each x In d.keys
dar.Add x
Next
dar.Sort
'vList becomes unique, sorted & has no blank
vList = dar.Toarray()
.List = vList
.DropDown
dar.Clear: d.RemoveAll

End With

Exit Sub
skip:
MsgBox "Incorrect data validation formula", vbCritical
ActiveCell.Offset(, 1).Activate
End Sub


Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
nFlag = False
With ComboBox1
Select Case KeyCode

Case 13 'Enter
If IsNumeric(Application.Match(.Value, vList, 0)) Or .Value = "" Then
Application.EnableEvents = False
ActiveCell = .Value
Application.EnableEvents = True
ActiveCell.Offset(ofs1, ofs2).Activate
Else
MsgBox "Wrong input", vbCritical
End If

Case 27, 9 'esc 'tab
ActiveCell.Offset(ofs1, ofs2).Activate

Case vbKeyDown, vbKeyUp
nFlag = True 'don't change the list when combobox1 value is changed by DOWN ARROW or UP ARROW key

End Select
End With
End Sub

Sub toShowCombobox()

Dim Target As Range

Set Target = ActiveCell

With ComboBox1
.Height = Target.Height + 5
.Width = Target.Width + 10
.Top = Target.Top - 2
.Left = Target.Offset(0, 1).Left
.Visible = True
.Activate
End With

End Sub


Private Sub ComboBox1_Change()

With ComboBox1

If nFlag = True Then Exit Sub
If Trim(.Value) = oldVal Then Exit Sub

If .Value <> "" Then

Call get_filterX
.List = d.keys
d.RemoveAll
.DropDown

Else 'if combobox1 is empty then get the whole list

If Not IsEmpty(vList) Then .List = vList

End If

oldVal = Trim(.Value)
End With

End Sub

Sub get_filterX()
'search without keyword order
Dim i As Long, x, z, q
Dim v As String
Dim flag As Boolean

d.RemoveAll
z = Split(UCase(ComboBox1.Value), " ")

For Each x In vList
flag = True: v = UCase(x)
For Each q In z
If InStr(1, v, q, vbBinaryCompare) = 0 Then flag = False: Exit For
Next
If flag = True Then d(x) = Empty
Next

End Sub

Sub get_filterY()
'search with keyword order
Dim x
Dim tx As String

d.RemoveAll
tx = UCase("*" & Replace((ComboBox1.Value), " ", "*") & "*")
For Each x In vList
If UCase(x) Like tx Then d(x) = Empty
Next

End Sub


Sub toEnable()
Application.EnableEvents = True
End Sub

 

[Akuini]

Can you post your code in the thread? For some reason it’s not showing up when I download your file.

It's in sheet "Status" code module.

In your test file you put my code in the wrong sheet. You should put it in the sheet where data validation is located, i.e. sheet "Status" code module. And just remove the code in sheet "Validation".

 

[mercer31]

It's in sheet "Status" code module.

In your test file you put my code in the wrong sheet. You should put it in the sheet where data validation is located, i.e. sheet "Status" code module. And just remove the code in sheet "Validation".

I don’t know what exactly is going on. I have the code on the “Status” sheet. When you download my file, you’re saying it’s showing up on the “Validation”sheet?

 

[mercer31]

I don’t know what exactly is going on. I have the code on the “Status” sheet. When you download my file, you’re saying it’s showing up on the “Validation”sheet?

Ignore my last message. Got it to work. Thanks for the help.

Another question. Is there a way to confine this code to just one single column?

 

[Akuini]

Is there a way to confine this code to just one single column?

What do you mean?
Do you mean you have data validation in multiple columns but you want it to apply only to 1 column, say, col A?

 

[mercer31]

What do you mean?
Do you mean you have data validation in multiple columns but you want it to apply only to 1 column, say, col A?

Exactly.

So I have another code for my month column that allows me to select multiple months. But, with this new code, I can only select one. I really only need this searchable feature for my “Work Type” column (I.e. column C). If I can confine my code to just that column, it would resolve my issue of not being able to select multiple options for a singular cell

 

[Akuini]

I really only need this searchable feature for my “Work Type” column (I.e. column C).

Replace "Private Sub Worksheet_BeforeDoubleClick" with this one:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If ComboBox1.Visible = True Then ComboBox1.Visible = False
If Not Intersect(Target, Range("C:C")) Is Nothing Then
    If Target.Cells.CountLarge = 1 And xFlag = False Then
        'if activecell has data validation type 3
        If isValid(Target) Then Call toShowCombobox: Cancel = True
    End If
End If
End Sub

 

[mercer31]

Replace "Private Sub Worksheet_BeforeDoubleClick" with this one:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If ComboBox1.Visible = True Then ComboBox1.Visible = False
If Not Intersect(Target, Range("C:C")) Is Nothing Then
    If Target.Cells.CountLarge = 1 And xFlag = False Then
        'if activecell has data validation type 3
        If isValid(Target) Then Call toShowCombobox: Cancel = True
    End If
End If
End Sub

That seemed to do it. One additional bug though. When you double click one of the other cells in columns “B”, “D”, etc, an error message “This value doesn’t match the data validation restrictions defined for this cell.” will pop up and start creating multiples of what was already in the cell when you cancel the error message. Any way to fix that?