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

 

[Norie]

You do give the listbox name, or the destination but here's an example.

Dim arrItems()
Dim cnt As Long
Dim I As Long

    For I = 0 To ListBox1.ListCount-1
        If ListBox1.Selected(I) Then
            ReDim Preserve arrItems(cnt) 
            arrItems = ListBox1.List(I)       
            cnt = cnt +1 
        End If
    Next I

    If cnt>0 Then
        Range("A" & Rows.Count).End(xlUp).Value = Join(arrItems, ",")
    End If

 

[awalt]

Thanks for the help. Would I use that in place of "ActiveCell.Offset(RowCount, 7).Value = ReasonList.Value" or in addition to?

You do give the listbox name, or the destination but here's an example.

Dim arrItems()
Dim cnt As Long
Dim I As Long

    For I = 0 To ListBox1.ListCount-1
        If ListBox1.Selected(I) Then
            ReDim Preserve arrItems(cnt) 
            arrItems = ListBox1.List(I)       
            cnt = cnt +1 
        End If
    Next I

    If cnt>0 Then
        Range("A" & Rows.Count).End(xlUp).Value = Join(arrItems, ",")
    End If

 

[Norie]

The code I posted creates a array of all the selected items in Listbox1 and then outputs that array as a comma delimited list to the next empty cell in column A.

First you'll need to replace ListBox1 with the name of your listbox and then change the code that puts the value from your listbox in the appropriate cell so that it puts the comma delimited list in the cell instead.

 

[awalt]

The code I posted creates a array of all the selected items in Listbox1 and then outputs that array as a comma delimited list to the next empty cell in column A.

First you'll need to replace ListBox1 with the name of your listbox and then change the code that puts the value from your listbox in the appropriate cell so that it puts the comma delimited list in the cell instead.

Thanks for the explaination. I believe I am adjusting the code correctly, however I am getting an error with the line "arrItems = ListBox1.List(I)" I tried making a new simple spreadsheet to test the code on it's own, but I am still coming up empty. Any idea what I could be doing wrong? I can send the spreadsheet if needed.

 

[Norie]

What error?

Did you change ListBox1 to the name of your listbox?

 

[awalt]

What error?

Did you change ListBox1 to the name of your listbox?

It was not working for me when I changed it to the name of my listbox, so I tried creating a simple form with a listbox, named ListBox1 and when it tries to submit the form the debugger says "type mismatch" and highlights "arrItems = ListBox1.List(I)"

 

[Norie]

Actually that's a typo made by me.

This is how the line should read.

arrItems(cnt) = ListBox1.List(I)

 

[awalt]

Actually that's a typo made by me.

This is how the line should read.

arrItems(cnt) = ListBox1.List(I)

No worries! Still trying to get it to work in my form. I got it working in my simple form, but it still won't submit any values into the document I actually need it on. Will try to work thru that.

I also cross posted and got some different code to try(below). I got this working right away for my first list box, but when I altered another listbox to also multi select, it would add anything selected in a listbox to the 2nd input cell.

For example:
In my first list box (categories) i selected "returns" and "checkout"
The next listbox (reasons) has values for something else, so I select "polite" and "follow up"

When submitted the categories populate into the correct cell with the correct values of "returns,checkout". The reasons populate in the correct cell but include "returns,checkout,polite,follow-up" it should only be the reasons selected.


Cross Posted: Storing multiple listbox values to one cell using UserForm

[COLOR=#333333]With ReasonList4[/COLOR]  For i = 0 To .ListCount - 1
    If .Selected(i) Then mytxt = mytxt & ", " & .List(i)
  Next i
End With [COLOR=#333333]ActiveCell.Offset(RowCount, 16).Value = Mid(mytxt, 3)[/COLOR]

 

[Norie]

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

You can do that like this.

mytxt = ""