Loop search multi column listbox

[mardy_bum]

Hi,

Background info, I have a spreadsheet where the user enters data which gets exported to a csv file. To try to reduce typo errors I have hidden sheets with all the reference data (this is a large data set which gets updated regularly).

I am trying to create a form where a user enters an ID into a textbox (called "txtCPH") they then click a button which searches Column A (CPH) in a hidden sheet (called "address") in the workbook for cells that match (there are multiple records for each ID). I then want it to display the cell values in columns B (First name), C (Surname) & D (postcode) where ever column A matches the search criteria, in a listbox. I want the user to be able to select one row from the results and click a button which will copy all the data in the selected row on the hidden sheet (address) and paste it on a new row in another sheet (called "stakeholders").

To give an example the user wants to see if there is a Joe Bloggs already associated with the CPH "234567". They type 234567 into the textbox and click search, this then brings up in the list box all the people associated with that CPH, Jane Doe, Joseph Bloggs and John Smith. The user then selects Joseph Bloggs and clicks the button add, this pastes all the details of Joseph bloggs from the reference data on a new row in the stakeholder sheet.

Where I am stuck: I am having problems displaying more than one column of data in my list box, I have tried various suggestions but none seem to work. I can not assign a fixed range as the reference data will increase over time, and I need it to search each record for a match - which is why I am using the loop method. This is my code so far..



Private Sub CommandButton1_Click()
Set xSht = Sheets("address")
Lastrow = xSht.Range("A" & Rows.Count).End(xlUp).Row
strSearch = txtCPH.Text
Set aCell = xSht.Range("A1:A" & Lastrow).Find(What:=strSearch, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not aCell Is Nothing Then
GoTo CPHvalid
Else
MsgBox "Oops! That CPH does not exist. Please try again."
txtCPH.Value = ""
End If
Exit Sub
CPHvalid:
lstResults.ColumnCount = 10
lstResults.ColumnWidths = "0;60;60;60;0;0;0;0;0;0"
row_number = 0
'clears the listbox so that you have dont have a continuously growing list
lstResults.Clear
Dim x As Integer
x = Me.lstResults.ListCount 'this is in case you don'T want to remove previous searches, it will append the new data at the end of the list
Do
DoEvents
row_number = row_number + 1
item_in_review = Sheets("address").Range("A" & row_number)
If item_in_review = txtCPH.Text Then
With lstResults
.AddItem
.List(x, 0) = item_in_review.Value
.List(x, 1) = item_in_review.Offset(0, 1).Value
.List(x, 2) = item_in_review.Offset(0, 2).Value
.List(x, 3) = item_in_review.Offset(0, 3).Value
.List(x, 4) = item_in_review.Offset(0, 4).Value
.List(x, 5) = item_in_review.Offset(0, 5).Value
.List(x, 6) = item_in_review.Offset(0, 6).Value
.List(x, 7) = item_in_review.Offset(0, 7).Value
.List(x, 8) = item_in_review.Offset(0, 8).Value
.List(x, 9) = item_in_review.Offset(0, 9).Value
x = x + 1
End With
End If
Loop Until item_in_review = ""
End Sub

[SamT]

I am having problems displaying more than one column of data in my list box
I think you mean more than one ROW of data.
Use a Find...FindNext loop.
You can add each row to the list by

lstResults.AddItem aCell.Row

[snb]

Sub M_snb()
with sheets("address").cells(1).currentregion
.autofilter 1, txtCPH.Text
.offset(1).copy sheets("address").cells(1,200)
lstresults.list=sheets("address").cells(1,200).currentregion.value
.autofilter
end with

lstresults.columncount=ubound(lstresuts.list,2)+1
lstresults.columnwidths="60" & replace(string(lstresults.columncount,";"),";",";60)
end sub

[Kenneth Hobs]

Similar to snb's approach, I used an autofilter and a scratch sheet. The column count and tabs are set manually. I used a button click event to trigger the fill though it is easily done otherwise.


Private Sub CommandButton1_Click()
Dim r As Range
With Worksheets("address")
Set r = .Range("A1:J" & .Range("A" & Rows.Count).End(xlUp).Row)
r.AutoFilter
r.AutoFilter field:=1, Criteria1:=txtCPH.Text
Set r = r.SpecialCells(xlCellTypeVisible)
.ShowAllData
.Range("A1").AutoFilter
End With

With Worksheets("Scratch")
.UsedRange.Clear
r.Copy .Range("A1")
'lstResults.RowSource = .UsedRange.Address(External:=True)
lstResults.List = .UsedRange.Value
End With
Application.CutCopyMode = False
End Sub

[mardy_bum]

Hi guys,

Thanks for all your suggestions! I had a little play about with it and managed to see the light! I am not sure if this is the neatest way of doing it (and am open to advice!!) however it seems to do what I want...

Private Sub CommandButton1_Click()
Set xSht = Sheets("address")
lastrow = xSht.Range("A" & Rows.Count).End(xlUp).Row
strSearch = txtCPH.Text
Set aCell = xSht.Range("A1:A" & lastrow).Find(What:=strSearch, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not aCell Is Nothing Then
GoTo CPHvalid
Else
MsgBox "Oops! There are no stakeholders associated with that CPH. Please use the individual search button."
End If
Exit Sub
CPHvalid:
Dim i As Integer
lstResults.ColumnCount = 4
lstResults.ColumnWidths = "60;60;60;0"
'clears the listbox so that you have dont have a continuously growing list
lstResults.Clear
For i = 1 To lastrow
item_in_review = Sheets("address").Range("A" & i)
If item_in_review = txtCPH.Text Then
'Adds the first name to the list box
lstResults.AddItem
lstResults.List(lstResults.ListCount - 1, 0) = Worksheets("address").Cells.Item(i, 2)
lstResults.List(lstResults.ListCount - 1, 1) = Worksheets("address").Cells.Item(i, 3)
lstResults.List(lstResults.ListCount - 1, 2) = Worksheets("address").Cells.Item(i, 4)
lstResults.List(lstResults.ListCount - 1, 3) = i
End If
Next i
End Sub
Private Sub cmdbaddtorecord_Click()
If lstResults.ListIndex <> -1 Then
For Z = 0 To lstResults.ListCount - 1
If lstResults.Selected(Z) Then
With Sheets("sheet2")
NextRow = .Range("B" & Rows.Count).End(xlUp).Row + 1
.Range("A" & NextRow) = txtCPH.Text
.Range("B" & NextRow) = Worksheets("address").Cells.Item(lstResults.List(lstResults.ListIndex, 3), 2)
.Range("C" & NextRow) = Worksheets("address").Cells.Item(lstResults.List(lstResults.ListIndex, 3), 3)
.Range("D" & NextRow) = Worksheets("address").Cells.Item(lstResults.List(lstResults.ListIndex, 3), 4)
.Range("E" & NextRow) = Worksheets("address").Cells.Item(lstResults.List(lstResults.ListIndex, 3), 5)
.Range("F" & NextRow) = Worksheets("address").Cells.Item(lstResults.List(lstResults.ListIndex, 3), 6)
.Range("G" & NextRow) = Worksheets("address").Cells.Item(lstResults.List(lstResults.ListIndex, 3), 7)
.Range("H" & NextRow) = Worksheets("address").Cells.Item(lstResults.List(lstResults.ListIndex, 3), 8)
.Range("I" & NextRow) = Worksheets("address").Cells.Item(lstResults.List(lstResults.ListIndex, 3), 9)
.Range("J" & NextRow) = Worksheets("address").Cells.Item(lstResults.List(lstResults.ListIndex, 3), 10)
End With
End If
Next Z
End If
End Sub

[mardy_bum]

Hi Kenneth and snb,

I tried to implement your code, but I was coming up with the same issue of only displaying the one column of data (CPH values in row A) in the list box. Thanks for pointing out the autofilter option as from what I've read its best to avoid loops if you can, I would really appreciate it if you could show me how to tweak it so that it produces the same result as my messy loop!!

[snb]

Did you use my code in your file ?
Upload that file so we can have a look.

[mardy_bum]

Hi I just had a double look and realised my school boy error - I missed out the columncount!!!

[mardy_bum]

1422414225

Hi here are the files, vba trials 2 is with your code, the other file is my work around...