VBA code to search and display results in multicolumn listbox

[jrperez.munloiza]

Ok, here is this one:

I would like to search for a particular data in a range and when it
finds it, say it found 10 ocurrences of the criteria, show the results
in a multicolumn listbox, being one of the column the cell address.
This is what I have until now:

Private Sub btnSrch_Click()

ActiveWorkbook.Sheets("Registry").Activate

Range("a8:a2010").Select
Selection.Find(What:=txtSrchTerm.Text, After:=ActiveCell,
LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext,
MatchCase:=False).Activate

With ListBox1
.AddItem
.List(0, 0) = ActiveCell.Offset(0, 46).Value
.List(0, 1) = ActiveCell.Value
.List(0, 2) = ActiveCell.Offset(0, 48).Value
.List(0, 3) = ActiveCell.Offset(0, 46).Address
End With

End Sub

' txtSrchTerm = a text box in the userform with the criteria to search

But that gives me only the first cell matching the criteria in the
listbox. How do I show all the results in the listbox?

 

[Tom Ogilvy]

Private Sub btnSrch_Click()
Dim cell as Range
Dim sAddr as String
Dim sh as Worksheet
Set sh = ActiveWorkbook.Sheets("Registry")

set cell = sh.Range("a8:a2010").Find( _
What:=txtSrchTerm.Text, _
After:=Range("A2010"), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchCase:=False)
if not cell is nothing then
sAddr = cell.Address
do
With ListBox1
.AddItem Cell.Offset(0, 46).Value
.List(0, 1) = Cell.Value
.List(0, 2) = Cell.Offset(0, 48).Value
.List(0, 3) = Cell.Offset(0, 46).Address
End With
set cell = sh.Range("A8:A2010").Findnext(cell)
loop while cell.Address <> sAddr
end if
end With
End Sub

 

[jrperez.munloiza]

Thanks for the help. It worked but, it only populates the first column
of the multicolumn listbox.

Juan

 

[jrperez.munloiza]

Correction: It populates all the columns in the first results, but
then only shows the first column results in the subsequent rows.

Juan

 

[Tom Ogilvy]

My fault. I didn't look at that part of your code:

.AddItem Cell.Offset(0, 46).Value
.List(0, 1) = Cell.Value
.List(0, 2) = Cell.Offset(0, 48).Value
.List(0, 3) = Cell.Offset(0, 46).Address

should be

.AddItem Cell.Offset(0, 46).Value
.List(.ListIndex, 1) = Cell.Value
.List(.ListIndex, 2) = Cell.Offset(0, 48).Value
.List(.ListIndex, 3) = Cell.Offset(0, 46).Address

 

[jrperez.munloiza]

Tom

Don't worry. It's a little long code.

But with the corrected code now it gives me this error:

Run-time error '381':
Could not set the List property. Invalid property array index.

This is a tough one...

Juan

 

[Tom Ogilvy]

sorry, mental glitch. .ListIndex should be .Listcount - 1

This is tested and worked for me:


Private Sub btnSrch_Click()
Dim cell As Range
Dim sAddr As String
Dim sh As Worksheet
Set sh = ActiveWorkbook.Sheets("Registry")

Set cell = sh.Range("a8:a2010").Find( _
What:=txtSrchTerm.Text, _
After:=Range("A2010"), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not cell Is Nothing Then
sAddr = cell.Address
Do
With ListBox1
.AddItem cell.Offset(0, 46).Value
.List(.ListCount - 1, 1) = cell.Value
.List(.ListCount - 1, 2) = cell.Offset(0, 48).Value
.List(.ListCount - 1, 3) = cell.Offset(0, 46).Address
End With
Set cell = sh.Range("A8:A2010").FindNext(cell)
Loop While cell.Address <> sAddr
End If

End Sub