Keyword Search - return multiple rows in listbox

[kklaus]

I need some help with a keyword search function. I have a button that when the user hits it, an InputBox appears asking for their keyword they would like to search. I need the results displayed in Listbox1.

I'm having 2 problems right now.

1. The code below is returning an error that says "Run-time error '91': Object variable or With block variable not set". It's highlighting this line of code when I click Debug:
If r.Address = ff Then Exit Do

2. In the listbox I need to return the complete string for the keyword they searched on AND the applicable code for that string.

Here's how the data looks on the "Class Code Desc" sheet.
Col A Col B
Amusement Centers 10015
Amusement Parks 10020
Antique Stores 10026

So if the user entered the keyword of "Amusement", the listbox should look like this:

10015 - Amusement Centers
10020 - Amusement Parks

Any help would be great!

Here is the code I have so far.

Private Sub CommandButton2_Click() 

Dim strReply As String 
Dim sht As Worksheet 
Dim cb As Object 
Dim lb As Object 
Dim Found As Range 
Dim strCell As String 
Dim r As Range, txt As String, sString As String, ff As String, gg As String 


Set lb = ListBox1.Object 

lb.Clear 
strReply = InputBox("Please enter Keyword", "Class Description Search") 
If strReply = "" Then Exit Sub 

Set sht = Worksheets("Class Code Desc") 

sht.Activate 

Set r = sht.Cells.Find(what:=strReply, after:=Cells(65536, 1), lookat:=xlPart) 
If Not r Is Nothing Then 
    ff = r.Address 
    strCell = Mid(ff, 4, Len(ff)) 
    txt = sht.Range("A" & strCell) 
    lb.AddItem txt 
    
    Do 
        Set r = Cells.FindNext(r) 
        If r.Address = ff Then Exit Do 
        gg = r.Address 
        strCell = Mid(gg, 4, Len(gg)) 
        txt = sht.Range("A" & strCell) 
        lb.AddItem.txt 
    Loop 
    
    lb.AddItem "" 
    
End If 
        
Set Found = sht.Cells.Find(what:=strReply, after:=Cells(65536, 1), lookat:=xlPart) 

If Not Found Is Nothing Then 
    Found.Activate 
    Exit Sub 
End If 

On Error GoTo 0 

If Found Is Nothing Then 
    MsgBox "Did not find" & strReply & ".", vbInformation 
End If

 

[PHV]

...
Set r = sht.Cells.Find(what:=strReply, after:=[!]sht.[/!]Cells(65536, 1), lookat:=xlPart)
...
Set r = [!]sht.[/!]Cells.FindNext(r)
...
Set Found = sht.Cells.Find(what:=strReply, after:=[!]sht.[/!]Cells(65536, 1), lookat:=xlPart)

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[kklaus]

Thanks so much.

Now I'm getting an "Object Required" error on this line of code:

lb.AddItem.txt

I have a Listbox call Listbox1 on the sheet so I'm not sure what's causing this error.

Also, do you know how to return multiple codes and descriptions in the listbox?

Thanks!!

 

[vladk]

Private Sub GetCodes()
Dim oFound As Range
Dim strFrstAddress As String
Dim strReply As String

lb.Clear
strReply = InputBox("Please enter Keyword", "Class Description Search")

If strReply = "" Then Exit Sub

With Worksheets("Class Code Desc").Range("a1:a500")

Set oFound = .Find(what:=strReply, LookIn:=xlValues, lookat:=xlPart)

If Not oFound Is Nothing Then
strFrstAddress = oFound.Address
Do
lb.AddItem oFound.Cells.Offset(0, 1).Value & " " & oFound.Value
Set oFound = .FindNext(oFound)
Loop While Not oFound Is Nothing And oFound.Address <> strFrstAddress
End If

End With

End Sub