Search as you type List Box in VBA

[sujittalukder]

The following is the vb code and working well with VB6 project. But when I am using the same with Excel VBA userform and not working.

Option Explicit

'Start a new Standard-EXE project.
'Add a textbox and a listbox control to form 1
'Add the following code to form1:

Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Integer, ByVal wParam As String, lParam As Any) As Long

Const LB_FINDSTRING = &H18F

Private Sub Form_Load()

    With List1
        .Clear
        .AddItem "RAM"
        .AddItem "rams"
        .AddItem "RAMBO"
        .AddItem "ROM"
        .AddItem "Roma"
        .AddItem "Rome"
        .AddItem "Rommel"
        .AddItem "Cache"
        .AddItem "Cash"
    End With

End Sub

Private Sub Text1_Change()
    List1.ListIndex = SendMessage(List1.hWnd, LB_FINDSTRING, Text1, ByVal Text1.Text)
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Text1.Text = List1.Text
End If
End Sub

This is the VBA code:

Option Explicit

Private Sub TextBox1_Change()
ListBox1.ListIndex = SendMessage(ListBox1.hWnd, LB_FINDSTRING, TextBox1, ByVal TextBox1.Text)
End Sub
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii = 13 Then
TextBox1.Text = ListBox1.Text
End If
End Sub
Private Sub UserForm_Initialize()
    With ListBox1
        .Clear
        .AddItem "RAM"
        .AddItem "rams"
        .AddItem "RAMBO"
        .AddItem "ROM"
        .AddItem "Roma"
        .AddItem "Rome"
        .AddItem "Rommel"
        .AddItem "Cache"
        .AddItem "Cash"
    End With
End Sub

The error is coming here at this line:

ListBox1.ListIndex = SendMessage(ListBox1.hWnd, LB_FINDSTRING, TextBox1, ByVal TextBox1.Text)

As Compile error : Metheod or data member not found. For this ListBox1.hWnd

In VB6, THE List1.hwnd property is available but in VBA Listbox1.hwnd is not coming.
How can I modify it to use with Excel VBA user form<

[Siddharth Rout]

Create a new class, call it clsHWnd. Paste the below code

Option Explicit
Public Name As String
Public hWnd As Long

In the userform, declare these APIs and a collection

Now try it

Option Explicit
 
Private Declare Function SendMessage Lib "user32" Alias _
"SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Integer, _
ByVal wParam As String, lParam As Any) As Long

Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

Private Declare Function GetFocus Lib "user32" () As Long

Private ListBoxCollection As Collection

Const LB_FINDSTRING = &H18F

Private Sub TextBox1_Change()
    ListBox1.ListIndex = SendMessage(ListBoxCollection("ListBox1").hWnd, _
    LB_FINDSTRING, TextBox1, ByVal TextBox1.Text)
End Sub

Private Sub TextBox1_KeyPress(ByVal KeyAscii As msforms.ReturnInteger)
    If KeyAscii = 13 Then
        TextBox1.Text = ListBox1.Text
    End If
End Sub

Private Sub UserForm_Initialize()
    Dim ctl As msforms.Control
    Dim listHWnd As clsHWnd
    Dim meHWnd As Long
    Dim res As Long
    
    With ListBox1
        .Clear
        .AddItem "RAM"
        .AddItem "rams"
        .AddItem "RAMBO"
        .AddItem "ROM"
        .AddItem "Roma"
        .AddItem "Rome"
        .AddItem "Rommel"
        .AddItem "Cache"
        .AddItem "Cash"
    End With
        Set ListBoxCollection = New Collection
        For Each ctl In UserForm1.Controls
            ctl.SetFocus
            Set listHWnd = New clsHWnd
            listHWnd.hWnd = GetFocus
            listHWnd.Name = ctl.Name
            ListBoxCollection.Add Item:=listHWnd, Key:=listHWnd.Name
        Next ctl
End Sub

Is this what you wanted?

[sujittalukder]

Hi,
Thanks for the code it is not working as desaired.
In the text box whwn I write Rambo it should select that word which in VB6 project doing but not here.

[Siddharth Rout]

ok let me check. I am going for a meeting. Will be back in an hour...

[sujittalukder]

Attaching both vb6 and excel files for your ready reference.

[Siddharth Rout]

ok forget about API's and HWNDS

Here is a simple way to achieve what you want... i.e. "search as you type"

Option Explicit
 
Private Sub TextBox1_Change()
    Dim x, z
    ListBox1.ListIndex = -1
    For x = 0 To ListBox1.ListCount - 1
        ListBox1.ListIndex = x
        z = ListBox1.Text
        If LCase(Left(ListBox1.Text, Len(TextBox1.Text))) = LCase(TextBox1.Text) Then
            Exit Sub
        End If
    Next x
End Sub

Private Sub TextBox1_KeyPress(ByVal KeyAscii As msforms.ReturnInteger)
    If KeyAscii = 13 Then
        TextBox1.Text = ListBox1.Text
    End If
End Sub

Private Sub UserForm_Initialize()
    With ListBox1
        .Clear
        .AddItem "RAM"
        .AddItem "rams"
        .AddItem "RAMBO"
        .AddItem "ROM"
        .AddItem "Roma"
        .AddItem "Rome"
        .AddItem "Rommel"
        .AddItem "Cache"
        .AddItem "Cash"
    End With
End Sub

Hope this helps...

[sujittalukder]

Thanks its working well but Keyascii code line is not working.

Private Sub TextBox1_KeyPress(ByVal KeyAscii As msforms.ReturnInteger)
    If KeyAscii = 13 Then
        TextBox1.Text = ListBox1.Text
    End If
End Sub

[Siddharth Rout]

Sorry about that ... I was concentrating so much on the textbox change that I missed that...

replace the above code with

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = 13 Then
        TextBox1.Text = ListBox1.Text
    End If
End Sub