Allow Typing but Restricting selection in a combo-box 1

[IjumpOverU]

How would you allow typing in a combo box wihtout allowing an entry that is not in the list.

I know that you can do this with a vbComboDropDownList in a standard combo-box, but this does not allow you to "filter" beyond the first chanracter.

I'm looking for something kind of like you get in Excel when type and it suggests a value from the list, but does not allow entry of characters that do not match a string in the list.

Did that make sense?

Thanks!

 

[vladk]

Private Sub Combo1_Validate(Cancel As Boolean)
Dim i As Integer
Dim blnListItemMatch As Boolean

For i = 0 To Combo1.ListCount - 1

If Combo1.Text = Combo1.List(i) Then
blnListItemMatch = True
Exit For
End If

Next i

Cancel = Not blnListItemMatch

End Sub

 

[DrJavaJoe]

'Here a class that I use just add a class module call it
'clsAutoCombo then add a combobox to form1 and run
Option Explicit
Private cCombo As New clsAutoCombo
Private Sub Combo1_KeyPress(KeyAscii As Integer)
KeyAscii = cCombo.AutoFind(Combo1, KeyAscii, True)
End Sub
Private Sub Form_Load()
Combo1.Clear
Combo1.AddItem "abc"
Combo1.AddItem "abd"
Combo1.AddItem "acd"
Combo1.AddItem "ddc"
Combo1.AddItem "xyz"
End Sub

'add to class module
Option Explicit
Const CB_GETEXTENDEDUI = &H156
Const CB_SETEXTENDEDUI = &H155
Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) _
As Long
Const CB_FINDSTRING = &H14C
Const CB_ERR = (-1)
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 Declare Function MoveWindow Lib "user32" _
(ByVal hwnd As Long, ByVal x As Long, ByVal y As _
Long, ByVal nWidth As Long, ByVal nHeight As Long, _
ByVal bRepaint As Long) As Long

Public Sub SetHeight(ByRef cboThis As ComboBox, CHeight As Long)
Dim ret
Dim iScaleMode
iScaleMode = cboThis.Parent.ScaleMode
cboThis.Parent.ScaleMode = vbPixels
ret = MoveWindow(cboThis.hwnd, cboThis.Left, cboThis.Top, cboThis.Width, CHeight, 1)
cboThis.Parent.ScaleMode = iScaleMode
End Sub

Public Property Let ComboExtendedUI(ByRef cboThis As ComboBox, ByVal bState As Boolean)
' Set whether combo box drops down using the Down Arrow or not:
SendMessageLong cboThis.hwnd, CB_SETEXTENDEDUI, Abs(bState), 0
End Property

Public Property Get ComboExtendedUI(ByRef cboThis As ComboBox) As Boolean
' Get whether combo box drops down using the Down Arrow or not:
ComboExtendedUI = (SendMessageLong(cboThis.hwnd, CB_GETEXTENDEDUI, 0, 0) <> 0)
End Property

Public Function AutoFind(ByRef cboCurrent As ComboBox, _
ByVal KeyAscii As Integer, _
Optional ByVal LimitToList As Boolean = False)

Dim lCB As Long
Dim sFindString As String

On Error GoTo Err_Handler
If KeyAscii = 8 Then
If cboCurrent.SelStart <= 1 Then
cboCurrent = &quot;&quot;
AutoFind = 0
Exit Function
End If
If cboCurrent.SelLength = 0 Then
sFindString = UCase(Left(cboCurrent, Len(cboCurrent) - 1))
Else
sFindString = Left$(cboCurrent.Text, cboCurrent.SelStart - 1)
End If
ElseIf KeyAscii < 32 Or KeyAscii > 255 Then
Exit Function
Else
If cboCurrent.SelLength = 0 Then
sFindString = UCase(cboCurrent.Text & Chr$(KeyAscii))
Else
sFindString = Left$(cboCurrent.Text, cboCurrent.SelStart) & Chr$(KeyAscii)
End If
End If
lCB = SendMessage(cboCurrent.hwnd, CB_FINDSTRING, -1, ByVal sFindString)

If lCB <> CB_ERR Then
cboCurrent.ListIndex = lCB
cboCurrent.SelStart = Len(sFindString)
cboCurrent.SelLength = Len(cboCurrent.Text) - cboCurrent.SelStart
AutoFind = 0
Else
If LimitToList = True Then
AutoFind = 0
Else
AutoFind = KeyAscii
End If
End If

Err_Handler:

End Function

 

[vladk]

Option Explicit

Private Sub Combo1_KeyPress(KeyAscii As Integer)
Dim i As Integer
Dim blnListItemMatch As Boolean

For i = 0 To Combo1.ListCount - 1
If Combo1.Text > vbNullString Then
If Left(Combo1.List(i), Len(Combo1.Text) + 1) = Combo1.Text & Chr(KeyAscii) Then
blnListItemMatch = True
Exit For
End If
End If
Next i

If blnListItemMatch Then
Combo1.Text = Combo1.List(i)
KeyAscii = 0
End If
End Sub

Private Sub Combo1_Validate(Cancel As Boolean)
Dim i As Integer
Dim blnListItemMatch As Boolean

For i = 0 To Combo1.ListCount - 1

If Combo1.Text = Combo1.List(i) Then
blnListItemMatch = True
Exit For
End If

Next i

Cancel = Not blnListItemMatch

End Sub

 

[jbradley]

Try something like this in your combo box's KeyPress event. The style of the ComboBox has to be set to Dropdown Combo.

Private Sub cboProdCats_KeyPress(KeyAscii As Integer)
' Procedure to simulate AutoComplete
    Dim lCnt       As Long 'Generic long counter
    Dim lMax       As Long
    Dim sComboItem As String
    Dim sComboText As String 'Text currently in combobox
    Dim sText      As String 'Text after keypressed

    With cboProdCats
        lMax = .ListCount - 1
        sComboText = .Text
        sText = Left(sComboText, intSelStart) & Chr(KeyAscii)
        
        KeyAscii = 0 'Reset key pressed
        
        For lCnt = 0 To lMax
            sComboItem = .List(lCnt)
            
            If UCase(sText) = UCase(Left(sComboItem, _
                                         Len(sText))) Then
                .ListIndex = lCnt
                .Text = sComboItem
                .SelStart = Len(sText)
                .SelLength = Len(sComboItem) - (Len(sText))
                
                Exit For
            End If
        Next 'lCnt
    End With
End Sub