I've created a multicolumn ListBox (2 columns) where I can search a customer name and have the results show customer part names in column 1 and corresponding part numbers in column 2. Once a user searches a customer name, I want to be able to extract the entire column 2 (of part numbers) to a separate tab in my workbook titled "New Profile Part Template" into a specific cell, J9.
My code is below. I've tried searching many options online but can't seem to find any code that accomplishes what I am trying to do.
Current code is listed below; CommandButton1 is supposed to initiate the pasting of ListBox column 2 into cell J9 with commas separating the numbers (but instead is pasting all data from Listbox Columns 1 and 2 into cell J9):
Option Explicit
' Display All Matches from Search in Userform ListBox
Dim FormEvents As Boolean
Private Sub ClearForm(Except As String)
' Clears the list box and text boxes EXCEPT the text box
' currently having data entered into it
Select Case Except
Case "FName"
FormEvents = False
LName.Value = ""
Results.Clear
FormEvents = True
Case "LName"
FormEvents = False
FName.Value = ""
Results.Clear
FormEvents = True
Case Else
FormEvents = False
FName.Value = ""
LName.Value = ""
Results.Clear
FormEvents = True
End Select
End Sub
Private Sub ClearBtn_Click()
ClearForm ("")
End Sub
Private Sub CloseBtn_Click()
Me.Hide
End Sub
Private Sub FName_Change()
If FormEvents Then ClearForm ("FName")
End Sub
Private Sub LName_Change()
If FormEvents Then ClearForm ("LName")
End Sub
Private Sub Results_Click()
End Sub
Private Sub SearchBtn_Click()
Dim SearchTerm As String
Dim SearchColumn As String
Dim RecordRange As Range
Dim FirstAddress As String
Dim FirstCell As Range
Dim RowCount As Integer
' Display an error if no search term is entered
If FName.Value = "" And LName.Value = "" Then
MsgBox "No search term specified", vbCritical + vbOKOnly
Exit Sub
End If
' Work out what is being searched for
If FName.Value <> "" Then
SearchTerm = FName.Value
SearchColumn = "Service Part"
End If
If LName.Value <> "" Then
SearchTerm = LName.Value
SearchColumn = "Part Number"
End If
Results.Clear
' Only search in the relevant table column i.e. if somone is searching Service Part Name
' only search in the Service Part column
With Sheet3.Range("Table1[" & SearchColumn & "]")
' Find the first match
Set RecordRange = .Find(SearchTerm, LookIn:=xlValues)
' If a match has been found
If Not RecordRange Is Nothing Then
FirstAddress = RecordRange.Address
RowCount = 0
Do
' Set the first cell in the row of the matching value
Set FirstCell = Sheet3.Range("A" & RecordRange.Row)
' Add matching record to List Box
Results.AddItem
Results.List(RowCount, 0) = FirstCell(1, 1)
Results.List(RowCount, 1) = FirstCell(1, 2)
RowCount = RowCount + 1
' Look for next match
Set RecordRange = .FindNext(RecordRange)
' When no further matches are found, exit the sub
If RecordRange Is Nothing Then
Exit Sub
End If
' Keep looking while unique matches are found
Loop While RecordRange.Address <> FirstAddress
Else
' If you get here, no matches were found
Results.AddItem
Results.List(RowCount, 0) = "Nothing Found"
End If
End With
End Sub
Private Sub CommandButton1_Click()
Dim i 'to store the item of the list
Dim j 'just a counter
Dim sht As Worksheet
Set sht = Sheets("New Profile Part Template")
j = 0 'Initiate the counter
For Each i In Me.Results.List
j = j + 1 'add one to the counter
sht.Cells(9, 10).Value = sht.Cells(9, 10).Value & Chr(10) & i
Next i
End Sub
Private Sub UserForm_Initialize()
FormEvents = True
End Sub
The Userform and multicolumn listbox work perfectly - it is the CommandButton1 towards the end of the code that is giving me issues. I need to extract only column 2 of the ListBox (named "Results") to cell J9, preferably with a space/comma separating the numbers.
If anyone can help me solve this, I will be forever grateful!!! :)
Try the following...
Private Sub CommandButton1_Click()
Dim sht As Worksheet
Set sht = Sheets("New Profile Part Template")
Dim data As Variant
data = Application.Index(Me.Results.List, 0, 2)
sht.Cells(9, 10).Value = Application.TextJoin(", ", True, data)
End Sub