Listbox displaying multiple search results as you type

[Julesdude]

Hi there all,
I have had limited success in posting here and so having had no response I am trying on this forum.

I have a simple userform containing a textbox and a listbox. What I want to happen is to have some code built in with the textbox_change event that takes what has been entered so far in that textbox (will be alphabetic characters) and searches for it within a specified range.

When a match is found, results should be listed in the 2 column listbox with column 1 containing an offset of the found cell by - 2 columns (same row) and column 2 containing the contents of the found cell.

There has to be some loop in doing this as if more than one match is found, it should list them all in the listbox so the user can select the item and this pulls through to another userform.

The code I have so far is not working. It DOESN'T populate the listbox and I'm not sure what I'm doing wrong.

Please can anyone help? Here is my code so far:

Private Sub UserForm_Initialize()
Sheets("Paste Artwork Matrix").Select
endrow = Range("G" & Rows.Count).End(xlUp).Row
Dim Data() As Variant
ReDim Data(1 To endrow - 1, 1 To 2)
For Row = 2 To endrow
Data(Row - 1, 1) = Cells(Row, "G")
Data(Row - 1, 2) = Cells(Row, "I")
Next Row
With SupplierList
.ColumnCount = 2
.ColumnWidths = "30;150"
'.RowSource = Range("G2:I798").Address
.List = Data
End With

End Sub
 
Private Sub TextBox1_Change()
Dim Fnd As String
Dim fCell As Range
Dim ws As Worksheet

SupplierListForm.SupplierList.Clear
Fnd = TextBox1.Value


Set ws = Worksheets("Paste Artwork Matrix")
    With ws
        Set fCell = .Range("I2:I979")
        For i = 1 To WorksheetFunction.CountIf(fCell, Fnd)
            Set fCell = .Cells.Find(what:=Fnd, After:=fCell, LookIn:=xlValues, _
                                    lookat:=xlPart, SearchOrder:=xlByRows, _
                                    SearchDirection:=xlNext, MatchCase:=False)
                                    
            If fCell Is Nothing Then
            SupplierList.Clear
                Exit For
            Else
                With SupplierList
                    .AddItem fCell.Value
                    .List = fCell.Value
                    .List = fCell.Offset(0, -2).Value
            End With
                
            End If
        Next i
    End With

    
    End Sub

 

[AlphaFrog]

Private Sub TextBox1_Change()
    
    Dim fCell As Range, fCells As Range
    Dim Firstfound As String
    
    SupplierListForm.SupplierList.Clear

    With Worksheets("Paste Artwork Matrix")
        Set fCells = .Range("I2", .Range("I" & Rows.Count).End(xlUp))
    End With
    
    Set fCell = fCells.Find(What:=TextBox1.Value & "*", _
                            After:=fCells(fCells.Count), _
                            LookIn:=xlValues, _
                            Lookat:=xlWhole, SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, MatchCase:=False)
                            
    If Not fCell Is Nothing Then
        Firstfound = fCell.Address
        Do
            With SupplierList
                .AddItem fCell.Offset(0, -2).Value
                .List(.ListCount - 1, 1) = fCell.Value
            End With
            Set fCell = fCells.FindNext(After:=fCell)
        Loop While fCell.Address <> Firstfound
    End If

End Sub

 

[Julesdude]

That was absolutely perfect. Thank you very much. I now have a system which works pretty much like Google's new search as you type function - the results' list in the listbox reduced the more characters are entered and the less results are found.

Thanks again!

 

[Norie]

Here's something with advanced filter.

http://www.box.net/shared/zqdgm3p63y

Not tested too much so not sure how it would work out in the long run - clearing ranges, filtering etc multiple times might cause problems.

 

[RyanExcel]

Private Sub TextBox1_Change()
    
    Dim fCell As Range, fCells As Range
    Dim Firstfound As String
    
    SupplierListForm.SupplierList.Clear

    With Worksheets("Paste Artwork Matrix")
        Set fCells = .Range("I2", .Range("I" & Rows.Count).End(xlUp))
    End With
    
    Set fCell = fCells.Find(What:=TextBox1.Value & "*", _
                            After:=fCells(fCells.Count), _
                            LookIn:=xlValues, _
                            Lookat:=xlWhole, SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, MatchCase:=False)
                            
    If Not fCell Is Nothing Then
        Firstfound = fCell.Address
        Do
            With SupplierList
                .AddItem fCell.Offset(0, -2).Value
                .List(.ListCount - 1, 1) = fCell.Value
            End With
            Set fCell = fCells.FindNext(After:=fCell)
        Loop While fCell.Address <> Firstfound
    End If

End Sub

I know this is an old thread, but I had to literally register on MrExcel, find this exact post, and thank the person responsible. You Sir, are one seriously awesome Exceller. Thank you!

Ryan

 

[AlphaFrog]

I know this is an old thread, but I had to literally register on MrExcel, find this exact post, and thank the person responsible. You Sir, are one seriously awesome Exceller. Thank you!

Ryan

Thanks Ryan and welcome to the forum.