Search-As-You-Type ComboBox Excel with possibility of continue typing

[Stonovsky]

Dear All,

I'm beginner in VBA and I've been trying to solve this for 2 days...
I have a problem with the continue typing in combobox with search option in userform.


The thing is that when I type a letter first match is autmatically a value of combobox and I can continue typing from the end of this word e.i. when i type "h" the word "Martha" is a cmb value and when I continue typing next letter e.i. "c" it goes to the end of Martha so it is like "Marthac". I would like to type "hc" in this case no matter if it fits the names or not .
Where I've made a mistake?

In worksheets("Names") I have a names as follows:

Name

Tom

John

Alex

Linda

Sophie

Martha

Elen

Henry

<tbody>
</tbody>

[COLOR=blue]Option Explicit[/COLOR] 
[COLOR=blue]Public[/COLOR] EnableEvents [COLOR=blue]As[/COLOR] [COLOR=blue]Boolean[/COLOR] 
[COLOR=blue]Private[/COLOR] [COLOR=blue]Sub[/COLOR] cmb_Name_Change() 
     
     
    [COLOR=blue]Dim[/COLOR] e, temp 
     
    [COLOR=blue]If[/COLOR] Me.EnableEvents = [COLOR=blue]False[/COLOR] [COLOR=blue]Then[/COLOR] Exit [COLOR=blue]Sub[/COLOR] 
    Me.EnableEvents = [COLOR=blue]False[/COLOR] 
     
     
    [COLOR=blue]With[/COLOR] Me 
         
         
        temp = .cmb_Name.Value 
        [COLOR=blue]If[/COLOR] [COLOR=blue]Not[/COLOR] .cmb_Name.MatchFound [COLOR=blue]Then[/COLOR] 
            .cmb_Name.Clear 
            [COLOR=blue]If[/COLOR] Len(temp) [COLOR=blue]Then[/COLOR] 
                [COLOR=blue]For Each[/COLOR] e [COLOR=blue]In[/COLOR] Sheets("Names").Cells(1).CurrentRegion.Columns(1).Offset(1).Value 
                    [COLOR=blue]If[/COLOR] (e <> "") * (e [COLOR=blue]Like[/COLOR] "*" & temp & "*") [COLOR=blue]Then[/COLOR] 
                        .cmb_Name.AddItem e 
                    [COLOR=blue]End[/COLOR] [COLOR=blue]If[/COLOR] 
                [COLOR=blue]Next[/COLOR] 
                [COLOR=blue]If[/COLOR] .cmb_Name.ListCount > 0 [COLOR=blue]Then[/COLOR] 
                    .cmb_Name.ListIndex = 0 
                [COLOR=blue]End[/COLOR] [COLOR=blue]If[/COLOR] 
            [COLOR=blue]End[/COLOR] [COLOR=blue]If[/COLOR] 
        [COLOR=blue]End[/COLOR] [COLOR=blue]If[/COLOR] 
    [COLOR=blue]End With[/COLOR] 
    Me.EnableEvents = [COLOR=blue]True[/COLOR] 
    Me.cmb_Name.DropDown 
[COLOR=blue]End Sub[/COLOR] 
 
 
 
 
[COLOR=blue]Private[/COLOR] [COLOR=blue]Sub[/COLOR] UserForm_Activate() 
    Me.EnableEvents = [COLOR=blue]True[/COLOR] 
[COLOR=blue]End Sub[/COLOR]

Thank you in advance for your help!

Tom.

 

[Worf]

Welcome to the Board

Private Sub cmb_Name_Change()
Dim e, temp
If Me.EnableEvents = False Then Exit Sub
Me.EnableEvents = False
With Me
    temp = .cmb_Name
    If Not .cmb_Name.MatchFound Then
        .cmb_Name.Clear
        If Len(temp) Then
            For Each e In Sheets("Names").Cells(1).CurrentRegion.Columns(1).Offset(1).Value
                If (e <> "") * (e Like "*" & temp & "*") Then .cmb_Name.AddItem e
            Next
            If .cmb_Name.ListCount > 0 Then .cmb_Name.ListIndex = 0
        End If
    End If
    .EnableEvents = True
    .cmb_Name = temp
    .cmb_Name.DropDown
End With
End Sub

 

[Stonovsky]

Thank you very much for your help but right now it works quite slow. Is there any possibility to speed it up?
On the other hand Is there any chance to turn off case sensitivity?

 

[Worf]

See if this is any faster; test it on a copy of your worksheet as it deletes data.
I will work on case sensitivity later.

Public EnableEvents As Boolean
Private Sub cmb_Name_Change()
Dim temp, s As Worksheet, r%
Set s = Sheets("names")
If Me.EnableEvents = False Then Exit Sub
Me.EnableEvents = False
With Me
    temp = .cmb_Name
    If Not .cmb_Name.MatchFound Then
        .cmb_Name.Clear
        If Len(temp) Then
            s.Range("d:d").ClearContents
            s.[c1] = s.[a1]                     ' header
            s.[c2] = "*" & temp & "*"           ' criterion
            Intersect(s.UsedRange, s.[a:a]).AdvancedFilter xlFilterCopy, s.[c1:c2], s.[d1], False
            r = s.Range("d" & Rows.Count).End(xlUp).Row
            If r = 2 Then
                Me.cmb_Name.AddItem s.[d2]
            Else
                Me.cmb_Name.List = s.Range("d2:d" & r).Value
            End If
            If .cmb_Name.ListCount > 0 Then .cmb_Name.ListIndex = 0
        End If
    End If
    .cmb_Name = temp
    .cmb_Name.DropDown
    .EnableEvents = True
End With
End Sub

Private Sub UserForm_Activate()
    Me.EnableEvents = True
End Sub

 

[Worf]

On the other hand Is there any chance to turn off case sensitivity?

The code above is not case sensitive.