excelvbalistboxuserformcommandbutton

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


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


Solution

  • 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