Multiple "Multiple Selection" ListBoxes in a VBA Userform

[DylanInvice]

Hello Everyone,

I am currently working in an internship where I must create excel VBA userforms, intended for clients. In these userforms, there are comboboxes and textboxes all which correctly transfer responses into an excel sheet. However, I have multiple “multiple selection” list boxes in which the information is copied over multiple times. The first list box selections appear in all subsequent list box cells. If my five listboxes were each assigned an integer from 1 to 5, the results to these listboxes would be displayed in the following way: [1],[1+2],[1+2+3], [1+2+3+4],[1+2+3+4+5]
Below I have included the code that I am currently using. I am trying to stop the responses from appearing in subsequent cells. Any help would be greatly appreciated! Thank you for your time.


Private Sub cmdOK_Click()


Dim listitems As String, i As Long


'find the next empty row
Sheets("Investor").Select
Nextrow = Application.WorksheetFunction.CountA(Range("B:B")) + 1
Cells(Nextrow, 2) = CoName.Text
Cells(Nextrow, 3) = Loc.Text
Cells(Nextrow, 4) = ComBoINVtype.Text

With Industry
For i = 0 To .ListCount - 1
If .Selected(i) Then listitems = listitems & .List(i) & ", "
Next i
End With

Cells(Nextrow, 5) = Left(listitems, Len(listitems) - 2)

With Sector

For i = 0 To .ListCount - 1

If .Selected(i) Then listitems = listitems & .List(i) & ", "
Next i
End With

Cells(Nextrow, 6) = Left(listitems, Len(listitems) - 2)

With Area
For i = 0 To .ListCount - 1
If .Selected(i) Then listitems = listitems & .List(i) & ", "
Next i
End With

Cells(Nextrow, 7) = Left(listitems, Len(listitems) - 2)

With Stage
For i = 0 To .ListCount - 1
If .Selected(i) Then listitems = listitems & .List(i) & ", "
Next i
End With

Cells(Nextrow, 8) = Left(listitems, Len(listitems) - 2)

With Size
For i = 0 To .ListCount - 1
If .Selected(i) Then listitems = listitems & .List(i) & ", "
Next i
End With

Cells(Nextrow, 9) = Left(listitems, Len(listitems) - 2)

Close Userform1

End Sub