displaying text box search results in a listbox

[Nitefox]

I am trying to create a search where the user types into the text box 'ItemDescription' then hits the 'ItemDescSearch' button (see below code) to pollute the list box 'lbSamDesc' with any partial matches from the specified range. Currently when I click on the button it takes about 8 seconds then no results are displayed in the List Box. What am I doing wrong?

Private Sub ItmDescSearch_Click()

    Dim c As Range, f As Range
    lbSamDesc.Clear
    For Each c In Worksheets("EquipmentData").Range("F6", Worksheets("EquipmentData").Range("F" & Rows.Count).End(xlUp))
    
        Set f = c.Find(ItemDescription.Value, lookat:=xlPart)
        If Not f Is Nothing Then
            lbSamDesc.AddItem c.Value
        End If
    Next c
    
End Sub

[6StringJazzer]

Impossible to know without seeing your data.

Although your code may work (I don't see anything obviously wrong with it), you are combining two methods that are not optimal when used like this. Find is very powerful for finding matches in an entire range of cells, but you are using Find one cell at a time. The following modification should speed things up but I can't tell why your code doesn't work without seeing your data, and I can't do a decent test without your file. I suggest you attach it.

Private Sub ItmDescSearch_Click()

    Dim c As Range, f As Range
    lbSamDesc.Clear
    Dim RangeToSearch As Range
    Dim fFirst As Range
    
    Set RangeToSearch = Worksheets("EquipmentData").Range("F6", Worksheets("EquipmentData").Range("F" & Rows.Count).End(xlUp))
    
    Set f = RangeToSearch.Find(ItemDescription.Value, lookat:=xlPart)
    Set fFirst = f
    
    Do Until f Is Nothing
    
        If f.Address = fFirst.Address Then Exit Do
        
        lbSamDesc.AddItem c.Value
        f = RangeToSearch.FindNext(f)
        
    Loop
    
End Sub

[Nitefox]

Thank your for the response.
I tried that code but it still doesn't seem to do anything for me. However I did notice that whatever it is doing it only took a second (verses the last code taking several).
I have attached a sample workbook with the data and userform.

Thanks,
James

[Nitefox]

Any thoughts Jeff?

[6StringJazzer]

Couple of bugs in the code, my fault. Providing your file made it possible to diagnose and resolve.

Private Sub ItmDescSearch_Click()

    Dim c As Range, f As Range
    lbSamDesc.Clear
    Dim RangeToSearch As Range
    Dim fFirst As Range
    
    Set RangeToSearch = Worksheets("EquipmentData").Range("C3", Worksheets("EquipmentData").Range("C" & Rows.Count).End(xlUp))
    
    Set f = RangeToSearch.Find(ItemDescription.Value, lookat:=xlPart)
    Set fFirst = f
    
    Do Until f Is Nothing
            
        lbSamDesc.AddItem f.Value
        Set f = RangeToSearch.FindNext(f)
        
        If f.Address = fFirst.Address Then Exit Do
        
    Loop
    
End Sub

[Nitefox]

Thanks Jeff that worked great (sorry I should have provided a file from the beginning).
Is it possible to have it remove the duplicates from the results?

Cheers,
james

[humdingaling]

adapted from
http://j-walk.com/ss/excel/tips/tip47.htm

Private Sub ItmDescSearch_Click()

    Dim c As Range, f As Range
    lbSamDesc.Clear
    Dim RangeToSearch As Range
    Dim fFirst As Range
    
    Set RangeToSearch = Worksheets("EquipmentData").Range("C3", Worksheets("EquipmentData").Range("C" & Rows.Count).End(xlUp))
    
    Set f = RangeToSearch.Find(ItemDescription.Value, lookat:=xlPart)
    Set fFirst = f
    
    Do Until f Is Nothing
            
        lbSamDesc.AddItem f.Value
        Set f = RangeToSearch.FindNext(f)
        
        If f.Address = fFirst.Address Then Exit Do
        
    Loop

    Dim i As Long, j As Long
    Dim nodupes As New Collection
    Dim Swap1, Swap2, Item
    
    With lbSamDesc
    
        For i = 0 To .ListCount - 1
            ' The next statement ignores the error caused
            ' by attempting to add a duplicate key to the collection.
            ' The duplicate is not added - which is just what we want!
            On Error Resume Next
            nodupes.Add .List(i), CStr(.List(i))
        Next i
   
    '   Resume normal error handling
        On Error GoTo 0
    
        'Clear the listbox
        .Clear
        
        'Sort the collection (optional)
        For i = 1 To nodupes.Count - 1
            For j = i + 1 To nodupes.Count
                If nodupes(i) > nodupes(j) Then
                    Swap1 = nodupes(i)
                    Swap2 = nodupes(j)
                    nodupes.Add Swap1, before:=j
                    nodupes.Add Swap2, before:=i
                    nodupes.Remove i + 1
                    nodupes.Remove j + 1
                End If
            Next j
        Next i
    
    '   Add the sorted and non-duplicated items to the ListBox
        For Each Item In nodupes
            .AddItem Item
        Next Item
        
    End With

End Sub

[6StringJazzer]

Nice code humdingaling--but Nitefox, wouldn't it be easier to just filter out duplicates from the original data?

[Nitefox]

Thanks humdingaling that did it.

[humdingaling]

Thanks both

agree with 6string
would be much easier to just clean original data set of duplicates

especially if you are going to branch out off this for other parts of potential project