Option Explicit
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const CB_FINDSTRING = &H14C
Private Const CB_ERR = (-1)
Private Function AutoComplete(ByRef CB As ComboBox, ByVal KeyAscii As Integer, Optional ByVal LimitToList As Boolean = False)
Dim FindMatch As Long
Dim ComboEntry As String
On Error GoTo ErrRtn
If KeyAscii = 8 Then
If CB.SelStart <= 1 Then
CB.Text = ""
AutoComplete = 0
Exit Function
End If
If CB.SelLength = 0 Then
ComboEntry = UCase(Left(CB, Len(CB) - 1))
Else
ComboEntry = Left$(CB.Text, CB.SelStart - 1)
End If
ElseIf KeyAscii < 32 Or KeyAscii > 127 Then
Exit Function
Else
If CB.SelLength = 0 Then
ComboEntry = UCase(CB.Text & Chr$(KeyAscii))
Else
ComboEntry = Left$(CB.Text, CB.SelStart) & Chr$(KeyAscii)
End If
End If
FindMatch = SendMessage(CB.hWnd, CB_FINDSTRING, -1, ByVal ComboEntry)
If FindMatch <> CB_ERR Then
CB.ListIndex = FindMatch
CB.SelStart = Len(ComboEntry)
CB.SelLength = Len(CB.Text) - CB.SelStart
AutoComplete = 0
Else
If LimitToList = True Then
AutoComplete = 0
Else
AutoComplete = KeyAscii
End If
End If
Exit Function
ErrRtn:
AutoComplete = 0
End Function
Private Sub cmboMyCombo_KeyPress(KeyAscii As Integer)
KeyAscii = AutoComplete(cmboMyCombo, KeyAscii, True)
End Sub
Private Sub Form_Load()
cmboMyCombo.AddItem "1000 Rt 2"
cmboMyCombo.AddItem "E. 42nd St"
End Sub