auto complete list box (type ahead search)

[Garrett]

I have a list box full of usernames. Right now (by default) I can press the first letter of the username and it goes to the first entry with that letter. what I want to be able to do is type the first few letters so the it brings focus to the exact item I want. just like the windows file system.

Any help is appriciated..
Thanks
Garrett

[onerrorgoto]

Hello
check out this tips. it might be o fsome help.
autocomplete
http://www.vb-world.net/tips/tip493.html

If not I know that I have smome code on aoutocomplete listbox at home. Or it might be aotucomplete combobox but I dont remember.
I'll post a new answer tomorrow.

[wasiq]

check out the file attached with this post, it is exactly what you want.

[adamtarshis]

This works in visio where listbox doesnt have a persistent handle to its window.

Option Explicit

    Private List1 As New Collection

    
Private Sub Text1_Change()
            
     
             Dim pos As Long
             Dim match As String
'            List1.ListIndex = SendMessage( _
'                                            List1., LB_FINDSTRING, -1, ByVal _
'                                            CStr(Text1.Text))
            match = FindString(Text1.Text)
            If Len(match) <= 0 Then
                pos = Text1.SelStart
            Else
                pos = Text1.SelStart
                Text1.Text = match
                Text1.SelStart = pos
                Text1.SelLength = Len(Text1.Text) - pos
            End If


End Sub


Private Sub Text1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
        On Error Resume Next
        If KeyCode = 8 Then 'Backspace
            If Text1.SelLength <> 0 Then
                Text1.Text = Mid$(Text1, 1, Text1.SelStart - 1)
                KeyCode = 0
            End If
        ElseIf KeyCode = 46 Then 'Del
                If Text1.SelLength <> 0 And _
                        Text1.SelStart <> 0 Then
                        Text1.Text = ""
                        KeyCode = 0
                End If
        End If
End Sub

Private Function FindString(ByVal subString As String) As String
    
            Dim i As Integer
            Dim length As Integer
            
             If List1.Count = 0 Then
                List1.Add "Orange"
                List1.Add "Banana"
                List1.Add "Apple"
                List1.Add "Pear"
            End If
            
            length = Len(subString)
            'catch delete
            If length = 0 Then
                Exit Function
            End If
            
            For i = 1 To List1.Count
                Debug.Print (List1.Count)
                
                If Left(List1.Item(i), length) = subString Then
                    FindString = List1.Item(i)
                    Exit Function
                End If
            Next i
            
            FindString = ""
    
End Function