copy the contents of a multicolumn listbox to a single cell on a worksheet

[stirlingmw]

Is there as way of sending the contents of a Multi Column Listbox to a single cell in a worksheet.

I am currently using the following code to send data from a Userform to Worksheet, but for some reason the data from my Multi Column listbox does not transfer over. The data is a combination of Job Role and Name of the person doing that role. The data must not over right any existing data in that cell.

Private Sub pSave()
Dim a As Long


If blnNew = True Then
totRows = Worksheets("Project Master").Range("A1").CurrentRegion.Rows.count
With Worksheets("Project Master").Range("A1")
.Offset(totRows, 0) = lstTeam.text

End With
Call comboboxFill 'This fi
Else
totRows = Worksheets("Project Master").Range("A1").CurrentRegion.Rows.count
For i = 2 To totRows
    If Trim(Worksheets("Project Master").Cells(i, 3)) = Trim(CmbFindProject.text) Then 'Finds project to update, or allows new data to be added to a new line
Worksheets("Project Master").Cells(i, 1) = lstTeam.text 'Multi Column listbox, 2 columns of data, lots of rows

Exit For
End If
Next i
End If
End Sub

Private Sub comboboxFill()
CmbFindProject.Clear
totRows = Worksheets("Project Master").Range("A1").CurrentRegion.Rows.count
For i = 2 To totRows
CmbFindProject.AddItem Worksheets("Project Master").Cells(i, 4).Value
Next i
End Sub

I also need for the data to be displayed in Multi Column format in lstTeam if already present when selected using CmbFindProject combobox.

Thanks in advance

Steve

 

[Yongle]

The generic code below concatenates column values of selected item in ListBox1 and writes that value to cell A1 in sheet "Results"
- adapt to suit your needs

Place code in the userform module

Private Sub CommandButton1_Click()
[COLOR=#006400][I]
'Variables[/I][/COLOR]
    Const T = vbCr & vbTab
    Dim x As Long, c As Long, xVal As String, box As Object, cel As Range
    Set box = ListBox1[I][COLOR=#006400]

'Create string from value selected in listbox[/COLOR][/I]
    With box
        For x = 0 To .ListCount - 1
                If .Selected(x) Then
                    xVal = .List(x)
                    For c = 1 To .ColumnCount - 1
                        xVal = xVal & "," & .List(x, c)
                    Next c
                End If
        Next x
    End With
[COLOR=#006400][I]
'write to cell A1 in sheet "Results"[/I][/COLOR]
    Set cel = Sheets("Results").Range("A1")
    If cel = "" Then
        cel = xVal
    Else
        If MsgBox("overwrite ..." & T & cel & vbCr & "with ..." & T & xVal, vbYesNo, "") = vbYes Then cel = xVal
    End If
 
End Sub