Save ListBox Multiselection to single Cell - excel

Question

I am working on a userform where users can edit entries from a list selection and save them to specific cells.
Private Sub CommandButton3_Click()
Dim lZeile As Long
If ListBox1.ListIndex = -1 Then Exit Sub
If Trim(CStr(TextBox_Name.Text)) = "" Then
MsgBox "Sie müssen mindestens einen Namen eingeben!", vbCritical + vbOKOnly, "FEHLER!"
Exit Sub
End If
lZeile = 2
Do While Trim(CStr(Tabelle4.Cells(lZeile, 1).Value)) <> ""
If ListBox1.Text = Trim(CStr(Tabelle4.Cells(lZeile, 1).Value)) Then
Tabelle4.Cells(lZeile, 1).Value = Trim(CStr(TextBox_Name.Text))
Tabelle4.Cells(lZeile, 11).Value = ListBox_Problem.Text
Tabelle4.Cells(lZeile, 12).Value = TextBox_Problem2.Text
Tabelle4.Cells(lZeile, 4).Value = ComboBox1.Text
Tabelle4.Cells(lZeile, 3).Value = ComboBox2.Text
Tabelle4.Cells(lZeile, 13).Value = TextBox3.Text
Tabelle4.Cells(lZeile, 14).Value = TextBox4.Text
If ListBox1.Text <> Trim(CStr(TextBox_Name.Text)) Then
Call UserForm_Initialize
If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
End If
Exit Do
End If
lZeile = lZeile + 1
Loop
End Sub
Now I have a ListBox where multiple entries can be selected. I want to write the selected entries into one single cell with "," as delimiter.
I have found the following code for that:
Dim i As Long
sText = ""
Range("B34").Value = ""
With Me.ListBox1
For i = 0 To .ListCount - 1
If .Selected(i) Then
sText = sText & ", " & .List(i)
End If
Next i
End With
sText = Mid(sText, 3)
If Len(sText) > 0 Then
Range("B34").Value = sText
Else
MsgBox "No selection made.", vbInformation
End If
I tried to incorporate it into mine but just cannot get it to work. I am not that fluent with VBA and was wondering if someone could help me?

Answer 1

The easiest way is to put your code (minor changes made) into a function:
Public Function GetCommaSeparatedListBoxItems(ByVal FromListBox As MSForms.ListBox) As String
Dim sText As String
With FromListBox
Dim i As Long
For i = 0 To .ListCount - 1 'loop through all items in the ListBox
If .Selected(i) Then 'chech each item if it is selected and if so …
sText = sText & ", " & .List(i) '… append this item comma delimited to `sText`
End If
Next i
End With
'since `sText` is empty in the beginning, data will always start with a comma, so removo that
'example data before: ", Item 1, Item 2, Item 3"
sText = Mid$(sText, 3)
'example data afterwards: "Item 1, Item 2, Item 3"
'return the comma separated items in the function
GetCommaSeparatedListBoxItems = sText
'Alternatively instead of the lise above you can …
If Len(sText) > 0 Then 'check if something was selected in the listbox and …
GetCommaSeparatedListBoxItems = sText '… return the value
Else
MsgBox "No selection made.", vbInformation '… or a error message
End If
End Function
That you can easily use like:
Debug.Print GetCommaSeparatedListBoxItems(FromListBox:=Me.ListBox1)
Example to write it into a cell you can use the function (in your first code) like:
Tabelle4.Cells(lZeile, 14).Value = GetCommaSeparatedListBoxItems(FromListBox:=Me.ListBox1)
you just need to adjust the code Me.ListBox1 to your multi select ListBox.