Hi
I have made a few changes to Jim's code so that u can store all the values in one list and only display the matches in another. It may or may not be what u want but anyways....
FORM - TEXT1, LIST1 (invisible) LIST2
VB Code:
Const LB_ERR = (-1) Const LB_FINDSTRING = &H18F Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As _ Long, ByVal wParam As Long, ByVal lParam As String) As Long Private Sub Form_load() Me.Show List1.Visible = False 'Sample data For x = 1 To 4 List1.AddItem Chr$(x + 64) Next List1.AddItem "earthmate" For x = 1 To 4 List1.AddItem Chr$(x + 68) Next List1.AddItem "earth" For x = 1 To 4 List1.AddItem Chr$(x + 72) Next Repopulate End Sub Private Sub Text1_Change() If Len(Text1.Text) = 0 Then Repopulate Else FindMatches Trim$(Text1.Text) End If End Sub Private Sub FindMatches(ByVal SearchText As String) Dim StopRepeat As Long 'Check to prevent endless looping Dim UpBound As Long 'upper bound of matches Dim x As Long 'counter Dim MySels() As Integer Dim retval As Long retval = 0 Where = 0 StopRepeat = 0 UpBound = -1 Do While retval <> LB_ERR retval = SendMessage(List1.hwnd, LB_FINDSTRING, Where, SearchText) If retval <= StopRepeat Then retval = LB_ERR If retval <> LB_ERR Then UpBound = UpBound + 1 ReDim Preserve MySels(UpBound) MySels(UpBound) = retval If UpBound = 0 Then StopRepeat = retval Where = retval End If Loop 'Fill second list with matches With List2 .Clear If Where > 0 Then For x = 0 To UBound(MySels) .AddItem List1.List(MySels(x)) Next End If If .ListCount > 0 Then .ListIndex = 0 End With End Sub Private Sub Repopulate() 'No search term so refill With List2 .Clear For x = 0 To List1.ListCount - 1 .AddItem List1.List(x) Next If .ListCount > 0 Then .ListIndex = 0 End With End Sub




Reply With Quote