Storing multiple listbox values to one cell using UserForm

A

awalt

New member
Joined
Aug 30, 2016
Messages
2
Reaction score
0
Points
0
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!

Code: 
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
 

Attachments

  • Form.jpg
    Form.jpg
    103.1 KB · Views: 56
If I want pictures I go to the pictures.
In an Excelforum we use Excel files: uploading, downloading.
 
possibly something along these lines:
Instead of:

ActiveCell.Offset(RowCount, 16).Value = ReasonList4.Value
Code: 
With ReasonList4
  For i = 0 To .ListCount - 1
    If .Selected(i) Then mytxt = mytxt & ", " & .List(i)
  Next i
End With
ActiveCell.Offset(RowCount, 16).Value = Mid(mytxt, 3)
 
Last edited:
p45cal said:
oh groan, you've cross posted without links:

I've wasted my effort, thanks a bunch.
awalt, for your information, you should always provide links to your cross posts.
This is a requirement, not just a request.
If you have cross posted at other places, please add links to them too.
Why? Have a read of
Click to expand...

Sorry, still new to this. (Obviously since this is my first post...) wasn't trying to waste your time. I will just go back to Mr.Excel. Thanks for the code.
 
You must log in or register to reply here.
Back
Top