Copying only one column of Userform ListBox data to single cell in separate spreadsheet with commas separating data

Question

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!!! :)

Answer 1

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

Answer 2

Just for fun an alternative to Domenic' s valid solution profiting from a temporary control which enables you to delete entire rows via the .RemoveItem method; the trick is to assign the Listbox elements to the temporary container via the .Column property (instead of the .List prop) which gets already transposed list data.

Deleting the first row isolates only one remaining row in this example (former column 2) which can now be joined easily to the wanted target cell.

More than the isolated application here, the appeal of this method lies in the fact that entire List rows can be processed using existing methods (such as .RemoveItem or .AddItem).

Private Sub CommandButton1_Click()
    Const Delim = ","
    Dim tgt As Range
    Set tgt = Sheet1.Cells(9, 10)         ' << change to any wanted target range
    
    With CreateObject("Forms.ComboBox.1") ' create temporary control holding data
        .List = Me.ListBox1.Column        ' get transposed ListBox1 elements
        .RemoveItem 0                     ' remove 1st row (former column 1)
        If .ListCount = 1 Then            ' only 1 remaining row
            tgt.Value = Join(WorksheetFunction.Transpose(.Column), Delim)
        End If
    End With

End Sub