• Home
 · 
• VB function enhancement
 · 
• ComboTypeAhead

ComboTypeAhead

Allows the VB combobox to have a type-ahead feature like the combobox in Access.
If there are any matching items in the combobox list, it will automatically
"fill in" the missing portions of the item and select it.
This will work for multiple characters, not just the first character of the string.
*** This is an expanded version of the original code ***
The updates allow for new items to be added into the list, automatically. It also
will handle the delete key (the previous code did not.)

Inputs
The combobox that you want to scan for entries in its list. Optionally, you can specify whether the comparison is case-sensitive.

Assumes
The function should be called as following (assuming a combobox call cboMine): Private Sub cboMine_Change() 'If the last key was not a special key (control), then use typeahead function If intLastKey >= 32 Then Call Combo_TypeAhead(cboMine) End Sub Private Sub cboMine_KeyDown(KeyCode As Integer, Shift As Integer) 'If the last key was a delete, then send a backspace to clear the selection If KeyCode = vbKeyDelete Then SendKeys "{BACKSPACE}", True End Sub Private Sub cboMine_KeyPress(KeyAscii As Integer) 'Sets the last key value for control character checking intLastKey = KeyAscii End Sub Private Sub cboMine_LostFocus() Call Combo_AddNew(cboMine) End Sub

Returns
n/a

API Declarations
Private intLastKey As Integer ' Records last keypress

Rate ComboTypeAhead

• 1
• 2
• 3
• 4
• 5

(3(3 Vote))

Public Sub Combo_AddNew(ByRef cboCurrent As ComboBox, _
  Optional blnCaseSensitive As Boolean = False, _
  Optional blnAddAsUpperCase As Boolean = True)
  
Dim lngServerNum As Long
Dim blnFoundMatch As Boolean
Dim strNewItem As String, strCurrentItem As String
strNewItem = cboCurrent.Text
If Not blnCaseSensitive Then strNewItem = UCase(strNewItem)
'Search for matches
blnFoundMatch = False
For lngServerNum = 0 To cboCurrent.ListCount - 1
 strCurrentItem = cboCurrent.List(lngServerNum)
 If Not blnCaseSensitive Then strCurrentItem = UCase(strCurrentItem)
 If strCurrentItem = strNewItem Then blnFoundMatch = True
Next lngServerNum
'If one is found, add and re-select
If Not blnFoundMatch Then
 If Not blnAddAsUpperCase Then
  cboCurrent.AddItem cboCurrent.Text
 Else
  cboCurrent.AddItem UCase(cboCurrent.Text)
 End If
 
 cboCurrent.ListIndex = cboCurrent.NewIndex
End If
  
End Sub
Public Sub Combo_TypeAhead(ByRef cboCurrent As ComboBox, _
  Optional blnCaseSensitive As Boolean = False)
'This function will allow the combobox cboCurrent to have the type-ahead feature _
found in Access. When the user types in text, it will look for a matching item in the _
list and add the remainder of the item on, and highlight the text.
'By default, the comparison is not case sensitive. If blnCaseSensitive is overridden _
with a true value, then it will consider case in the comparison.
Dim lngItemNum As Long, lngSelectedLength As Long, lngMatchIndex As Long
Dim strSearchText As String, strCurrentText As String
'Check for empty control, and abort if found
If cboCurrent.Text = "" Then Exit Sub
'Set up initial values for search
lngMatchIndex = -1
strSearchText = cboCurrent.Text
If Not blnCaseSensitive Then strSearchText = UCase(strSearchText)
lngSelectedLength = Len(strSearchText)
'Search all items for first match
For lngItemNum = 0 To cboCurrent.ListCount - 1
 strCurrentText = Mid(cboCurrent.List(lngItemNum), 1, lngSelectedLength)
 If Not blnCaseSensitive Then strCurrentText = UCase(strCurrentText)
 
 'If a match is found, record it and abort loop
 If strSearchText = strCurrentText Then
  lngMatchIndex = lngItemNum
  Exit For
 End If
Next lngItemNum
'If a match was found, select it and highlight the "filled in" text
If lngMatchIndex >= 0 Then
 cboCurrent.ListIndex = lngMatchIndex
 cboCurrent.SelStart = lngSelectedLength
 cboCurrent.SelLength = Len(cboCurrent.List(cboCurrent.ListIndex)) - lngSelectedLength
End If
End Sub