I created an Excel add-in called “Search deList”, to create searchable data validation

[Akuini]

I created an add-in called “Search deList”, and I share it as a freeware.
Its function is to speed up searching in data validation list. In any cell that has data validation (with List type) pressing ALT+RIGHT will open a Userform with a combobox. You can type multiple keywords (separated by a space) in the combobox and the list will be narrowed down as you type.
I’d be appreciate if anyone can test this add-in to find any bugs or just suggesting ideas to improve its functionality.
Also, the code is not protected by password, so if anyone needs to change or add specific feature or behavior then feel free to amend the code, and if you need help for that I’ll help if I can.

How it works:

• In any cell that has data validation (with List type) pressing ALT+RIGHT will open a Userform with a combobox.
• Type some keywords to search, separated by a space, e.g "ma la"
• The list will be narrowed down as you type.
• The search ignores the keywords order, so the keyword "ma la" would match "Maryland" and "Alabama".
• You can use up-down arrow to select an item, then hit ENTER, the selected item will be inserted into the cell, and the userform will be closed.
• You can also use single-click to select an item, then DOUBLE-CLICK inside the box, the selected item will be inserted into the cell, and the userform will be closed.
• To leave the combobox without inserting its value to the activecell: hit TAB or ESC
• Numeric values in the list will be treated as text.
• In the Status Bar you can see how many unique items are found & displayed.
• You don't need VBA (except if you want to use additional feature as I explain below), so you can save your workbook as .xlsx.

Additional feature :
If you want, you can also activate the userform by double-clicking a cell, but you need VBA to do that. Here’s how:
Copy-paste this code into Thisworkbook code window of your workbook:

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
If TypeName(Selection) = "Range" Then
    Dim v
    On Error Resume Next
        v = ActiveCell.Validation.Type
    On Error GoTo 0
    'if activecell has data validation type 3
    'run "Search deList" add-in by doubke-clicking a cell
    If v = 3 Then Cancel = True: Application.Run ("toShow__dheeDAV")
End If
End Sub

Now, in every sheet, double-clicking any cell that has data validation (with List type) will open the Userform.

Image:

How to use it:

1. Install the add-in. This article explains how to install an add-in: How to install or uninstall an Excel Add-in - Excel Off The Grid
2. Open any workbook that has data validation (with list type).
3. In any cell that has data validation, pressing ALT+RIGHT will open a Userform with a combobox.
4. Play with it & see how it works.

NOTES:

• This add-in also works on dependent data validation.
• It works on large list (I tested it on 100K rows of data).
• One caveat of using macro is when macro changes/writes something on sheet it will delete Undo Stack, so at that time you can't use UNDO. In this case it happens every time the combobox value is inserted into the active cell.

Search_deList_v1 add-in:
Search_deList_v1

=========================================================================================

Update, 2022-Nov-18:
Search deList v.2.1 + manual.zip, it works on Excel 2007 or later:

Search deList v.2.1 + manual

MediaFire is a simple to use free service that lets you put all your photos, documents, music, and video in a single place so you can access them anywhere and share them everywhere.

www.mediafire.com

Search deList v.365.1 + manual.zip, it works on Excel 365 or later

Search deList v.365.1.1 + manual

MediaFire is a simple to use free service that lets you put all your photos, documents, music, and video in a single place so you can access them anywhere and share them everywhere.

www.mediafire.com

This new version has some additional features, some of them:
Several ways to search, like using AND or OR or LIKE operator , with or without keyword order.
Sort the list by original order or ascending order.
Widen or shorten the combobox width at run time.
Insert multiple entries into the cell.

=======================================================================================

Regards,
Akuini

 

[Akuini]

I have just seen this, Akuini... Nice work !!
Thanks for sharing.

You're welcome, hope this is useful.

 

[Jaafar Tribak]

You're welcome, hope this is useful.

• One caveat of using macro is when macro changes/writes something on sheet it will delete Undo Stack, so at that time you can't use UNDO. In this case it happens every time the combobox value is inserted into the active cell.

Maybe you should consider using the SendInput API (more reliable than SendKeys) to write the text to the DV cell. This should work as the cell remains activated when the userform closes which means that any keyboard input is guaranteed to be sent to the DV cell..
That way, the Undo Stack won't be affected as it mimics writing to the cell manually.

 

[Akuini]

Maybe you should consider using the SendInput API (more reliable than SendKeys) to write the text to the DV cell. This should work as the cell remains activated when the userform closes which means that any keyboard input is guaranteed to be sent to the DV cell..
That way, the Undo Stack won't be affected as it mimics writing to the cell manually.

That's a very interesting idea. I have thought about using SendKey but couldn’t make it work.
I'm not familiar with SendInput API & Windows API in general, but I know you are expert in this field. Any chance you could write the code for me?
The code in the add-in is unprotected, so you can modify it as needed. I would love it if you would be willing to write the code & test it.

 

[Jaafar Tribak]

@Akuini

I have downloaded your addin (your last update deList v.365.1) and have made a few changes to incorporate the SendInput API idea.

Changes that I have made:

1- Added this new helper routine;

Sub SendSringAPI(ByVal sText As String)

    Const KEYEVENTF_KEYUP = &H2, KEYEVENTF_UNICODE = &H4, VK_CONTROL = &H11
    Dim oDataObj As DataObject
    Dim i As Long

    If Len(sText) Then
 
       Set oDataObj = New DataObject
       oDataObj.SetText sText
       oDataObj.PutInClipboard
 
       ReDim InputArray(4&) As tagINPUT_keybd
 
       InputArray(0&).INPUTTYPE = 1&
       InputArray(0&).ki.wVk = VK_CONTROL
       InputArray(0&).ki.dwFlags = KEYEVENTF_UNICODE
 
       InputArray(1&).INPUTTYPE = 1&
       InputArray(1&).ki.wVk = AscW("V")
       InputArray(1&).ki.dwFlags = KEYEVENTF_UNICODE
 
       InputArray(2&).INPUTTYPE = 1&
       InputArray(2&).ki.wVk = VK_CONTROL
       InputArray(2&).ki.dwFlags = KEYEVENTF_UNICODE + KEYEVENTF_KEYUP
 
       InputArray(3&).INPUTTYPE = 1&
       InputArray(3&).ki.wVk = AscW("V")
       InputArray(3&).ki.dwFlags = KEYEVENTF_UNICODE + KEYEVENTF_KEYUP
 
       Call SendInput(4&, InputArray(0&), LenB(InputArray(0&)))
 
    End If

End Sub

2- Commented out theses lines in the sentValue routine:
If Left(tx, 1) = "0" Then If IsNumeric(tx) Then ActiveCell = "'" & tx ''insert as text, e.g: "01" will remain "01" instead of "1" Else ActiveCell = tx End If Else ActiveCell = tx End If

and Replace them with the following:
If Left(tx, 1) = "0" Then If IsNumeric(tx) Then SendSringAPI "'" & tx Else SendSringAPI tx End If Else SendSringAPI tx End If


3- Commented out this line in the UserForm Terminate Event:
'ActiveCell.Offset(OffsetRow, OffsetCol).Activate



Here is the entire UserForm Module code with all the included changes inc the API declarations ;

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function SendInput Lib "user32.dll" (ByVal cInputs As Long, pInputs As Any, ByVal cbSize As Integer) As Long
#Else
    Private Enum LongPtr
        [_]
    End Enum
    Private Declare Function SendInput Lib "user32.dll" (ByVal cInputs As Long, pInputs As Any, ByVal cbSize As Integer) As Long
#End If

Private Type tagKEYBDINPUT
    wVk As Integer
    wScan As Integer
    dwFlags As Long
    time As Long
    dwExtraInfo As LongPtr
    #If Win64 Then
        padding As LongPtr
    #End If
End Type

Private Type tagINPUT_keybd
    INPUTTYPE As Long
    ki As tagKEYBDINPUT
End Type


' Search deList add-in, created by Akuini, Nov 2021, Indonesia
' Search_deList_v_365.1.xlam   'update 15-Nov-2022
'=================================================================================================
'=============== ADJUST THE CODE IN THIS PART: ===================================

'max number of rows displayed in the combobox
Private Const LN As Long = 500  'change to suit

'where the cursor go after leaving the combobox
Private OffsetRow As Long   'row offset
Private OffsetCol As Long   'column offset


Private Const Sprt As String = ", "  'separator of multiple entries

'-------- Do not change this part --------------
Private vList                   'complete list
Private d As Object
Private dv_Formula As String    'data validation formula

Private nFlag As Boolean    'nFlag = True 'don't change the list when combobox1 value is changed by DOWN ARROW or UP ARROW key
Private wFlag As Boolean    'if there's error then unload userform
Private oldVal As String    'previous combobox1.text
Private kFlag As Boolean    'kFlag = True 'make sure ComboBox1_Change won't run createList again; If kFlag = False Then Call createList  'in createList > kFlag = True
Private F5flag As Boolean   'F5flag = True 'in Sub createList just sort list if vList is not empty & sortFlag = True
Private F9flag As Boolean   'to insert multiple entries, F9 key
Private cFlag As Boolean    'cFlag = True 'skip combobox dropdown (in continuous_mode) when using keydown/keyup in TETXBOX


Private Sub UserForm_Initialize()

'where the cursor go after leaving the combobox
OffsetRow = 1: OffsetCol = 0

'resizing userform
If xUF_Size(1) <> 0 Then
        Me.Width = xUF_Size(1)
        Me.ComboBox1.Width = xUF_Size(2)
        Me.Label1.Left = xUF_Size(3)
End If
      
'===============================

Call set_Position
Call changeColor


    With Me
        .ComboBox1.MatchEntry = fmMatchEntryNone
        .TextBox1.Text = txb_SearchMode
        .TextBox1.ControlTipText = "Search mode: blank or type 1,2, or 3 in textbox"
  
        If sortFlag = False Then
            .Caption = "Search deList v365.1 - Sort Order: original"
        Else
            .Caption = "Search deList v365.1 - Sort Order: ascending"
        End If
    End With

End Sub

Private Sub UserForm_Terminate()

    Application.StatusBar = Empty
    'ActiveCell.Offset(OffsetRow, OffsetCol).Activate
    txb_SearchMode = Me.TextBox1.Text

End Sub


Sub set_Position()
'this code to place the userform base on active cell position is from Yin Cognyto
'https://stackoverflow.com/questions/41884148/how-do-i-align-a-userform-next-to-the-active-cell

  Dim pointcoordinates As pointcoordinatestype, horizontaloffsetinpoints As Double, verticaloffsetinpoints As Double
    With Me

        horizontaloffsetinpoints = (.Width - .InsideWidth) / 2
        verticaloffsetinpoints = 6
        Call GetPointCoordinates(ActiveCell, pointcoordinates)
        .StartUpPosition = 0
'        .Top = pointcoordinates.Top - verticaloffsetinpoints
        .Top = pointcoordinates.Bottom - .Height + verticaloffsetinpoints
        .Left = pointcoordinates.Left - horizontaloffsetinpoints + 1


    End With
End Sub

Private Sub ComboBox1_Change()

Call change_CBO
End Sub

Private Sub ComboBox1_DropButtonClick()

If IsEmpty(vList) Then
        Call createList
End If

End Sub

Private Sub ComboBox1_Click()

    If nFlag = False Then
'        OffsetRow = 1: OffsetCol = 0
        Call sentValue
    End If
    nFlag = False
End Sub

Sub change_CBO()
Dim tx As String

If kFlag = False Then Call createList  'in createList > kFlag = True

'don't change the list when combobox1 value is changed by DOWN ARROW or UP ARROW key
If nFlag = True Then Exit Sub

If wFlag = True Then Unload Me 'if error on Sub createList()
 
    With Me.ComboBox1
          tx = RTrim(.Text)
            If tx = oldVal Then Exit Sub
          
            oldVal = tx
              
            If Trim(.Text) <> "" And .ListIndex > -1 Then Exit Sub
      
            If Trim(tx) <> "" Then
              
                    Select Case TextBox1.Text
                  
                        Case ""
                            Call get_filterX     'search without keyword order & use AND operator. (This is the default)
                        Case "1"
                            Call get_filterY     'search with keyword order & use AND operator
                        Case "2"
                            Call get_filterXX    'search without keyword order & use OR operator
                        Case "3"
                            Call get_filterLike  'search using LIKE operator ( case insensitive)

                    End Select
                      
 
                        .List = toList(d.keys)   'd.keys come from get_filter above
                        d.RemoveAll
                        .DropDown


            Else 'if combobox1 is empty then get the whole list
              
                    .List = toList(vList)
              
            End If
  
    End With


End Sub

Private Sub TextBox1_Change()

Dim x As Long
Dim tx As String
With Me.TextBox1
    Select Case .Text
        Case "", "1", "2", "3"
            'do nothing
        Case Else
            Beep
            .Text = ""
            Exit Sub
    End Select

 
        Call createList
        nFlag = True
        ComboBox1.Text = ""
        oldVal = oldVal & "~"
        nFlag = False
 
    Select Case .Text
        Case ""
            Me.Caption = "Search without keyword order & use AND operator. (This is the default)"
        Case "1"
            Me.Caption = "Search with keyword order,  & use AND operator"
        Case "2"
            Me.Caption = "Search without keyword order & use OR operator"
        Case "3"
            Me.Caption = "Search using LIKE operator (case insensitive)"
  
    End Select
 
    If .Text <> "" Then Me.ComboBox1.SetFocus
              
End With

End Sub

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim a As Long, b As Long
    Select Case KeyCode
        Case 27 'ESC  'leaving combobox without inserting its value into the active cell
              Unload Me
  
        Case vbKeyDown
                Call textbox_key(1, 0)
  
        Case vbKeyUp
                If ActiveCell.Row > 1 Then Call textbox_key(-1, 0)
    End Select

End Sub

Sub textbox_key(y As Long, z As Long)
Dim a As Long, b As Long

        a = OffsetRow: b = OffsetCol
        OffsetRow = y: OffsetCol = z
        cFlag = True
            Call continuous_mode
            OffsetRow = a: OffsetCol = b
        cFlag = False
End Sub


Sub createList()

Dim x, vb, ary
Dim c As Range
Dim msg As String
Dim n As Long

If Not IsEmpty(vList) And F5flag = True And sortFlag = True Then
'when it runs from F5 key & vList is not empty
    If UBound(vList, 1) > 1 Then vList = WorksheetFunction.Sort(vList)
    F5flag = False
Else
    dv_Formula = ActiveCell.Validation.Formula1
 
    msg = "Can't get the range as the list source from data validation formula." & vbLf & "Please, check the formula:" & vbLf & dv_Formula
  
        On Error GoTo skip

        Set c = Evaluate(dv_Formula)
  
        If Not c Is Nothing Then
            vb = c.Value
        Else 'if formula doesn't return a range
            GoTo skip
        End If
             Set d = CreateObject("scripting.dictionary"): d.CompareMode = vbTextCompare
  
             If Not IsArray(vb) Then 'if only 1 item
                    ReDim vList(1 To 1, 1 To 1): vList(1, 1) = vb
             Else
                For Each x In vb
                    d(CStr(x)) = Empty 'convert number to text, unique, 1D  array, Lbound = 0, 'case insensitive
                Next
                If d.Exists("") Then d.Remove ""
          
                If d.Count = 0 Then
                    ReDim vList(1 To 1, 1 To 1): vList(1, 1) = ""      '2D array, Lbound = 1
                Else
                    ReDim vList(1 To d.Count, 1 To 1) '2D array, Lbound = 1
                    n = 0
                    For Each x In d.keys
                        n = n + 1
                        vList(n, 1) = x
                    Next
              
                End If
 
                If sortFlag = True Then
                        If UBound(vList) > 1 Then vList = WorksheetFunction.Sort(vList)   '2d array, Lbound = 1 'case insensitive
                End If
      
            End If
 
End If
 
 
    With Me.ComboBox1
        .List = toList(vList)
    End With
 
    kFlag = True 'make sure ComboBox1_Change won't run createList again

If sortFlag = False Then
    Me.Caption = "Sort Order: original (hit F5 to toggle)"
Else
    Me.Caption = "Sort Order: ascending (hit F5 to toggle)"
End If

Exit Sub
skip:
If Err.Number > 0 Then
MsgBox "Error number: " & Err.Number & vbLf & Err.Description
End If
On Error GoTo 0
       MsgBox msg: wFlag = True

End Sub


Sub sentValue()
'insert combobox value into the active cell

Dim tx As String

'If F5flag = True Then F5flag = False: Exit Sub 'if come from F5 key
 
    With Me.ComboBox1
        tx = .Text
        If .ListIndex > -1 Then
          
                    If F9flag = True Then
                        If ActiveCell <> Empty Then tx = ActiveCell & Sprt & tx  'hit F9 to insert mutiple entries
                    End If
              
                    '**********************************************************
                    ' CODE SECTION REPLACEMENT FOR SENDINPUT API
                    If Left(tx, 1) = "0" Then
                        If IsNumeric(tx) Then
                          SendSringAPI "'" & tx      ''insert as text, e.g: "01" will remain "01" instead of "1"
                        Else
                           SendSringAPI tx
                        End If
                    Else
                        SendSringAPI tx
                    End If
                    '**********************************************************
'
'                If Left(tx, 1) = "0" Then
'                    If IsNumeric(tx) Then
'                       ActiveCell = "'" & tx    ''insert as text, e.g: "01" will remain "01" instead of "1"
'                    Else
'                       ActiveCell = tx
'                    End If
'                Else
'                    ActiveCell = tx
'                End If
          
 
        ElseIf tx = "" Then
                'do nothing
        Else
                MsgBox "Wrong input", vbCritical
                Exit Sub
        End If
 
    End With
 
                If F9flag Then 'insert mutiple entries mode
                    'do nothing
                ElseIf pF8flag Then 'non-continuous_mode
                    Unload Me
                Else
                    Call continuous_mode
                End If
End Sub

Sub continuous_mode()
              
    Dim v
    On Error Resume Next
        v = ActiveCell.Offset(OffsetRow, OffsetCol).Validation.Type
    On Error GoTo 0
    'if activecell has data validation type 3
     If v = 3 Then
            If Not IsError(Evaluate(ActiveCell.Offset(OffsetRow, OffsetCol).Validation.Formula1)) Then
                ActiveCell.Offset(OffsetRow, OffsetCol).Activate
                If ActiveCell.Validation.Formula1 = dv_Formula Then
            
                   nFlag = True
                   ComboBox1.Text = Empty
                   nFlag = False
                   ComboBox1.List = toList(vList)
 
                Else
            
                   vList = Empty
                   nFlag = True
                   ComboBox1.Text = Empty
                   nFlag = False
                   Call createList
          
                End If
                    set_Position
              
                    If cFlag = False Then ComboBox1.DropDown 'to make the focus stay on combobox instead of textbox
            Else
                Unload Me
            End If
     Else
            Unload Me
     End If
End Sub



Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim tx As String
Dim va

'note: using F4 will trigger Sub ComboBox1_DropButtonClick

nFlag = False
With Me.ComboBox1
    Select Case KeyCode


  
        Case vbKeyDown, vbKeyUp
             nFlag = True 'don't change the list when combobox1 value is changed by DOWN ARROW or UP ARROW key
  
      
        Case 13 'ENTER
'                OffsetRow = 1: OffsetCol = 0  'where the cursor go after leaving the combobox
' ActiveCell.Offset(-1).Activate

                Call sentValue
'             Unload Me
        Case 27 'ESC  'leaving combobox without inserting its value into the active cell
              Unload Me

 
        Case vbKeyF1
            toResize ("-") 'resize userform
            Me.Caption = "Hit F1 & F2 to decrease or increase the combobox size."
      
        Case vbKeyF2
            toResize ("+") 'resize userform
            Me.Caption = "Hit F1 & F2 to decrease or increase the combobox size."
      
  
        Case vbKeyF5 'sort in ascending or original order
            sortFlag = Not sortFlag  'sortFlag = True means sort in ascending order
            F5flag = True 'in Sub createList just sort list if vList is not empty & sortFlag = True
            Call createList
            If Me.ComboBox1.Text <> "" Then
                oldVal = oldVal & "~" 'make sure oldVal is different from combobox1.text
                Call change_CBO 'need to recreate list base on selected sort order
            End If
            Call changeColor
      
                If sortFlag Then
                    Me.Caption = "Sort order: ascending (hit F5 to toggle)"
                Else
                    Me.Caption = "Sort order: original (hit F5 to toggle)"
                End If
  
  
        Case vbKeyPageUp, vbKeyPageDown
            nFlag = True 'don't change the list
  
        Case vbKeyF8  'toggle Continuous mode
            pF8flag = Not pF8flag
      
            If pF8flag Then
                Me.Caption = "Non-continuous mode (hit F8 to toggle)"
            Else
                Me.Caption = "Continuous mode (hit F8 to toggle)"
            End If
      
        Case vbKeyF9 'to insert multiple entries, F9 key
      
            If Me.ComboBox1.ListIndex > -1 Then
          
                If InStr(1, Sprt & ActiveCell.Value & Sprt, Sprt & ComboBox1.Text & Sprt, vbTextCompare) > 0 Then
                    If MsgBox("This entry already exist in the active cell." & vbLf & "Do you want to insert it anyway?", vbOKCancel, "Warning!!!") = vbCancel Then Exit Sub
                End If
                    F9flag = True
                    Call sentValue  ''to insert multiple entries, F9 key
                    F9flag = False

            Else

                MsgBox "Wrong input", vbCritical
            End If

    End Select
End With
End Sub

Sub toResize(q As String)
Dim m As Long

If q = "+" Then m = 30 Else m = -30
  
            xUF_Size(1) = Me.Width + m
            If xUF_Size(1) < 150 Then Exit Sub
            xUF_Size(2) = ComboBox1.Width + m
            xUF_Size(3) = Label1.Left + m

            Me.Width = xUF_Size(1)
            ComboBox1.Width = xUF_Size(2)
            Label1.Left = xUF_Size(3)

End Sub

Sub get_filterX()
'search without keyword order & use AND operator, this is the default
Dim i As Long, x, z, q
Dim v As String
Dim flag As Boolean
 
    d.RemoveAll
    z = Split(UCase(WorksheetFunction.Trim(Me.ComboBox1.Text)), " ")

    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_filterXX()
'search without keyword order & use OR operator, type "2"
Dim i As Long, x, z, q
Dim v As String
Dim flag As Boolean
 
    d.RemoveAll
    z = Split(UCase(WorksheetFunction.Trim(Me.ComboBox1.Text)), " ")

    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 = False Then d(x) = Empty
    Next

End Sub

Sub get_filterY()
'search with keyword order & use AND operator
Dim i As Long, j As Long, m As Long, n As Long
Dim tx As String
Dim x, z, q, va
Dim v As String
Dim flag As Boolean
Dim uFlag As Boolean 'if no space at the beginning

    d.RemoveAll

    tx = Me.ComboBox1.Text
    z = Split(UCase(WorksheetFunction.Trim(tx)), " ")
 
    If Left(tx, 1) <> " " Then uFlag = True
  
    For Each x In vList
        flag = True
        v = UCase(x)
  
        If uFlag = True Then 'if no space at the beginning
      
            If InStr(1, v, z(0), vbBinaryCompare) <> 1 Then
                flag = False
            Else
                j = 1
                For Each q In z
                    m = InStr(j, v, q, vbBinaryCompare)
                        If m = 0 Then flag = False: Exit For
                    j = m + 1
                Next
            End If
  
        Else
      
            j = 1
            For Each q In z
                m = InStr(j, v, q, vbBinaryCompare)
                    If m = 0 Then flag = False: Exit For
                j = m + 1
            Next
  
        End If


        If flag = True Then d(x) = Empty
    Next

End Sub


Sub get_filterLike()
'type "3", search using LIKE operator (case insensitive),
Dim x
Dim tx As String
 
On Error GoTo skip
'    If Len(tx) > 1 Then
        d.RemoveAll
        tx = UCase((Me.ComboBox1.Text))
 
        For Each x In vList
            If UCase(x) Like tx Then d(x) = Empty
        Next
'    End If
Exit Sub
skip:
Me.Caption = "Wrong pattern"
On Error GoTo 0

End Sub

Function toList(va As Variant)
Dim xList, h As Long, i As Long, x
Dim tx As String
'va is vList or d.keys
' vList is 2D array, LBound = 1
' d.keys is 1D array, LBound = 0


    If LBound(va) = 0 Then h = UBound(va) + 1 Else h = UBound(va)
    If h > LN Then
  
        ReDim xList(1 To LN)
        i = 0
        For Each x In va
            i = i + 1
            xList(i) = x
            If i = LN Then Exit For
        Next
        toList = xList
        Me.Caption = "Found: " & h & ", Shown: " & LN & tx
    Else
        toList = va
        Me.Caption = "Found: " & h & ", Shown: " & h & tx
    End If


End Function


Sub changeColor()
    With Me.ComboBox1
        If sortFlag = False Then 'original
'            .BackColor = RGB(255, 251, 232)
            .BackColor = RGB(255, 251, 242)
        Else
            .BackColor = vbWhite 'sort ascending
        End If
    End With

End Sub


Private Sub Label1_Click()

MsgBox "Search deList v365.1 by Akuini" _
& vbLf & "" _
& vbLf & "THE KEYS TO USE WHEN THE CURSOR IS IN THE COMBOBOX" _
& vbLf & "" _
& vbLf & "ENTER, SINGLE-CLICK" _
& vbLf & "use up-down arrow to select an entry > hit ENTER or SINGLE-CLICK to insert the entry into the cell." _
& vbLf & "" _
& vbLf & "ESC" _
& vbLf & "to exit the combobox without inserting its value to the cell." _
& vbLf & "" _
& vbLf & "F1  F2" _
& vbLf & "to decrease or increase the combobox width." _
& vbLf & "" _
& vbLf & "F5" _
& vbLf & "to toggle sort order: original (the default) or ascending (A-Z). " _
& vbLf & "" _
& vbLf & "F8" _
& vbLf & "to toggle insert mode: continuous (the default) or non-continuous." _
& vbLf & "" _
& vbLf & "F9" _
& vbLf & "insert multiple entries into the cell" _
& vbLf & "" _
& vbLf & "THE KEYS TO USE WHEN THE CURSOR IS IN THE TEXTBOX" _
& vbLf & "KEYDOWN, KEYUP" _
& vbLf & "Go to the cell below/above the active cell without inserting any values to the active cell."


MsgBox "The search rules:" & vbLf & _
"" & vbLf & _
"There is a textbox to the left of the combobox." & vbLf & _
"You can have different search mode by typing “1” or “2” or “3” on the textbox or leave it empty." & vbLf & _
"" & vbLf & _
"The textbox is empty, this is the default. Search without keyword order & use AND operator." & vbLf & _
"Type “ma la”. It would match “Maryland” and “Alabama”, but not “Land”" & vbLf & _
"" & vbLf & _
"Type “1” > search with keyword order & a space acts like “*” and add “*” after the keywords." & vbLf & _
"“ ma la”, (there’s a space in the beginning).  It would match “Maryland”, “In Maryland”, but not “Alabama”." & vbLf & _
" “ma la”, (no space in the beginning). It would match “Maryland”, but not “In Maryland”. " & vbLf & _
"" & vbLf & _
"Type “2” > search without keyword order & use OR operator." & vbLf & _
"“ma la”. It would match “Maryland”, “Alabama”, “Land”, “remain”." & vbLf & _
"" & vbLf & _
"Type “3” > search with keyword order & use LIKE operator." & vbLf & _
"“##”. It would match “34”, but not “345”." & vbLf & _
"“## a”. It would match “34 A”, but not “A 34”."


End Sub


'Routine to Copy ComBoBox Value to ClipBoard and send CTRL + V
Sub SendSringAPI(ByVal sText As String)

    Const KEYEVENTF_KEYUP = &H2, KEYEVENTF_UNICODE = &H4, VK_CONTROL = &H11
    Dim oDataObj As DataObject
    Dim i As Long

    If Len(sText) Then
 
       Set oDataObj = New DataObject
       oDataObj.SetText sText
       oDataObj.PutInClipboard
 
       ReDim InputArray(4&) As tagINPUT_keybd
 
       InputArray(0&).INPUTTYPE = 1&
       InputArray(0&).ki.wVk = VK_CONTROL
       InputArray(0&).ki.dwFlags = KEYEVENTF_UNICODE
 
       InputArray(1&).INPUTTYPE = 1&
       InputArray(1&).ki.wVk = AscW("V")
       InputArray(1&).ki.dwFlags = KEYEVENTF_UNICODE
 
       InputArray(2&).INPUTTYPE = 1&
       InputArray(2&).ki.wVk = VK_CONTROL
       InputArray(2&).ki.dwFlags = KEYEVENTF_UNICODE + KEYEVENTF_KEYUP
 
       InputArray(3&).INPUTTYPE = 1&
       InputArray(3&).ki.wVk = AscW("V")
       InputArray(3&).ki.dwFlags = KEYEVENTF_UNICODE + KEYEVENTF_KEYUP
 
       Call SendInput(4&, InputArray(0&), LenB(InputArray(0&)))
 
    End If

End Sub

Note:
Basically, all the code does is just copy the selected value\text from the combobox to the clipboard and automatically pastes to the DV cell. Similar to the familiar: SendKeys "^c" then SendKeys "^v" but more reliable.

This worked for me when testing and keeps the UNDO STACK intact ... It is worth noting that I have tested this in Ewxel 2016 x64bit - Win10 x64

If you don't want to alter\mess with the clipboard, we can still use the same SendInput approach but it will be a bit slower as it will need to iterate through each character in the string... The larger the string of the selected value\text from the combobox, the slower the code will run.

Hope this works for you too.

Regards.

 

[Akuini]

Here is the entire UserForm Module code with all the included changes inc the API declarations ;

I really appreciate your interest in this project.
I've replaced the code in the userform with your code. Here's what happened:

• This line Private Enum LongPtr turned red.

• When I clicked on "Debug > Compile VBAProject," no error message appeared.
• I tested it on the sheet by opening the userform, selecting an item in the combobox, and then hitting Enter. However, nothing happened—the value in the active cell didn't change, and no error message was displayed.
• While debugging, I confirmed that the code executed the "Sub SendStringAPI(ByVal sText As String)" function and continued until it finished without raising any errors. Nevertheless, nothing happened in the active cell.

So, no errors but the value of the combobox is not sent to the active cell.

Note:
I'm using Excel 365 32-bit on Windows 10.
I've added a reference to “Microsoft Forms 2.0 Object Library”. It's a requirement to use the code, right?

 

[Jaafar Tribak]

Try removing the #If Win64 close in the tagKEYBDINPUT UDT defined in the top declarations section and see what happens:

So this :
Private Type tagKEYBDINPUT wVk As Integer wScan As Integer dwFlags As Long time As Long dwExtraInfo As LongPtr #If Win64 Then padding As LongPtr #End If End Type

Shoud become this:
Private Type tagKEYBDINPUT wVk As Integer wScan As Integer dwFlags As Long time As Long dwExtraInfo As LongPtr padding As LongPtr End Type

This line Private Enum LongPtr turned red

That's fine... You can simply ignore all the lines in red and leave them as they are ... Those red lines will only compile in VBA6. (ie:= excel 2007 or earlier versions) ... This is called Conditional Compilation.

I've added a reference to “Microsoft Forms 2.0 Object Library”. It's a requirement to use the code, right?

Since your addin uses a userform for holding the combobox, the “Microsoft Forms 2.0 Object Library” is already loaded by default so no need to worry about explicitly referencing the library in your vbaproject.

 

[Akuini]

Try removing the #If Win64 close in the tagKEYBDINPUT UDT defined in the top declarations section and see what happens:

Ok, I replaced Private Type tagKEYBDINPUT with the new one.
Still the same, no change in the active cell & no error.

Does it matter that I'm using Excel 32-bit on Win 10 64-bit?

Since your addin uses a userform for holding the combobox, the “Microsoft Forms 2.0 Object Library” is already loaded by default so no need to worry about explicitly referencing the library in your vbaproject.

Ah, thanks, I didn't know that.

 

[Jaafar Tribak]

Does it matter that I'm using Excel 32-bit on Win 10 64-bit?

Might be . Unfortunately, I don't have x32bit excel for testing.

Try declaring the UDT padding member as Currency instead pf LongPtr as follows:
Private Type tagKEYBDINPUT wVk As Integer wScan As Integer dwFlags As Long time As Long dwExtraInfo As LongPtr padding As Currency End Type

 

[Jaafar Tribak]

Also, just to make sure that calling the SendSringAPI is placed in the right locations thoughout the code, let's try the native Application SendKeys Method and see what happens:

Replace the SendSringAPI routine with this one :

Sub SendSringAPI(ByVal sText As String)

    Dim oDataObj As DataObject

    If Len(sText) Then
       Set oDataObj = New DataObject
       oDataObj.SetText sText
       oDataObj.PutInClipboard
       SendKeys "^v"
       DoEvents
       SendKeys "^v"
    End If

End Sub

 

[Akuini]

Try declaring the UDT padding member as Currency instead pf LongPtr as follows:

I did it, still the same result.

Also, just to make sure that calling the SendSringAPI is placed in the right locations thoughout the code, let's try the native Application SendKeys Method and see what happens:
Replace the SendSringAPI routine with this one :

Also the same thing happened.
It looks like the code pasted the text into the combobox itself.