mardy_bum
08-20-2015, 06:52 AM
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
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