Storing multiple listbox values to one cell using UserForm

[awalt]

Hi there!

I am working on creating a userform for quality assurance data entry. Basically I want my form to find the next blank row in my sheet and enter in the data selected on the form. I currently have it working where a single entry can be made into each cell, but I have a few list boxes where I would like it to enter multiple selections into one box separated by commas. For example:

One list box has:

Empathy
Actively Listens
Spelling/Grammar

If I select Empathy and Actively listens in the list box on my form I want it to display the following in one cell:

Empathy, Actively Listens

I know I need to have the multiselect property on the listbox set to 1-fmMultiSelectMulti, but I'm unsure of the code needed to get my multiple selections. Below is the code for the form I have so far. I am still pretty new to VBA. I have pictures of the form and sheet if needed. Thanks for the help!

Private Sub ClearButton_Click()


DateOfInteractionBox.Value = Clear
TypeDropDown.Value = "Pick One"
CategoryList.Value = Clear
OrderNumberBox.Value = Clear


SPK4.Value = False
SPK3.Value = False
SPK2.Value = False
SPK1.Value = False
ReasonList.Value = Clear
NotesList.Value = Clear


PS4.Value = False
PS3.Value = False
PS2.Value = False
PS1.Value = False
ReasonList2.Value = Clear
NotesList2.Value = Clear


PO4.Value = False
PO3.Value = False
PO2.Value = False
PO1.Value = False
ReasonList3.Value = Clear
NotesList3.Value = Clear


C4.Value = False
C3.Value = False
C2.Value = False
C1.Value = False
ReasonList4.Value = Clear
NotesList4.Value = Clear


SentToRep.Value = False
AdditionalNotes.Value = Clear


End Sub










Private Sub SubmitButton_Click()


Dim i As Integer
'position cursor in the correct cell A2.
    Range("B3").Select
    i = 1 'set as the first ID


Do Until IsEmpty(ActiveCell.Value)
        ActiveCell.Offset(1, 0).Select 'move down 1 row
        i = i + 1 'keep a count of the ID for later use
    Loop


'Populate the new data values into the 'Data' worksheet.
    ActiveCell.Value = i 'Next ID number




'Transfer information
With Worksheets("QA Evaluation Chart").Range("B3")


ActiveCell.Offset(RowCount, 0).Value = InputDateBox.Value
ActiveCell.Offset(RowCount, 1).Value = QARepBox.Value
ActiveCell.Offset(RowCount, 2).Value = DateOfInteractionBox.Value
ActiveCell.Offset(RowCount, 3).Value = TypeDropDown.Value
ActiveCell.Offset(RowCount, 4).Value = OrderNumberBox.Value
ActiveCell.Offset(RowCount, 5).Value = CategoryList.Value






'System Process Knowledge
If SPK4.Value = True Then ActiveCell.Offset(RowCount, 6).Value = "4"


If SPK3.Value = True Then ActiveCell.Offset(RowCount, 6).Value = "3"


If SPK2.Value = True Then ActiveCell.Offset(RowCount, 6).Value = "2"


If SPK1.Value = True Then ActiveCell.Offset(RowCount, 6).Value = "1"




ActiveCell.Offset(RowCount, 7).Value = ReasonList.Value


ActiveCell.Offset(RowCount, 8).Value = NotesList.Value


'Problem Solving
If PS4.Value = True Then ActiveCell.Offset(RowCount, 9).Value = "4"


If PS3.Value = True Then ActiveCell.Offset(RowCount, 9).Value = "3"


If PS2.Value = True Then ActiveCell.Offset(RowCount, 9).Value = "2"


If PS1.Value = True Then ActiveCell.Offset(RowCount, 9).Value = "1"




ActiveCell.Offset(RowCount, 10).Value = ReasonList2.Value


ActiveCell.Offset(RowCount, 11).Value = NotesList2.Value


'Productivity and Organization
If PO4.Value = True Then ActiveCell.Offset(RowCount, 12).Value = "4"


If PO3.Value = True Then ActiveCell.Offset(RowCount, 12).Value = "3"


If PO2.Value = True Then ActiveCell.Offset(RowCount, 12).Value = "2"


If PO1.Value = True Then ActiveCell.Offset(RowCount, 12).Value = "1"




ActiveCell.Offset(RowCount, 13).Value = ReasonList3.Value


ActiveCell.Offset(RowCount, 14).Value = NotesList3.Value


'Communication
If C4.Value = True Then ActiveCell.Offset(RowCount, 15).Value = "4"


If C3.Value = True Then ActiveCell.Offset(RowCount, 15).Value = "3"


If C2.Value = True Then ActiveCell.Offset(RowCount, 15).Value = "2"


If C1.Value = True Then ActiveCell.Offset(RowCount, 15).Value = "1"




ActiveCell.Offset(RowCount, 16).Value = ReasonList4.Value


ActiveCell.Offset(RowCount, 17).Value = NotesList4.Value


End With


If SentToRep.Value = True Then ActiveCell.Offset(RowCount, 21).Value = "Yes"


ActiveCell.Offset(RowCount, 24).Value = AdditionalNotes.Value


End Sub




Private Sub CloseButton_Click()


Unload Me


End Sub

 

[awalt]

I think you might need to clear mytxt before you go on to the next listbox.

You can do that like this.

mytxt = ""

Thanks so much for your help, I got this working just the way I need it!