multiselect list box

[Larren]

I hope someone can help, it's been awhile since I've used VBA. I'm trying to create a user form w/ multiselect list box, once the user as selected 2 or more options I want these to be copied to the worksheet in one cell seperated by comma's or at this point a space will do. All I can come up with is getting each selection in it's own cell which isn't what I'm needing. Any ideas, All help is much appriciated :think:

[Norie]

Can you post what you have so far?

[Larren]

Here's what I have for the submit button, any suggestions ?

Thank you sooo much!!


Private Sub cmdSubmit_Click()
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("KMS")
Dim lItem As Long
'find first empty row in database
iRow = ws.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row


'copy the data to the database
ws.Cells(iRow, 1).Value = Me.cmbD.Value
ws.Cells(iRow, 2).Value = Me.cmbI.Value
ws.Cells(iRow, 3).Value = Me.ListBox1.Value
ws.Cells(iRow, 4).Value = Me.txtTW.Value


For lItem = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(lItem) = True Then

ws.Range("C65536").End(xlToRight) = ListBox1.List(lItem)
ListBox1.Selected(lItem) = False
End If
Next

'clear the data
Me.cmbD.Value = ""
Me.txtTW.Value = ""
Me.cmbI.Value = ""
Me.ListBox1.Value = ""

Me.cmbD.SetFocus

End Sub

[Norie]

Try this.


For lItem = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(lItem) = True Then
strList = strList & ListBox1.List(lItem) & ","
ListBox1.Selected(lItem) = False
End If
Next
ws.Range("C65536").End(xlToRight) = Left(strList, Len(strList) - 1)

[mdmackillop]

For commas,


Private Sub CommandButton1_Click()
For lItem = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(lItem) = True Then
strList = strList & ListBox1.List(lItem) & ", "
ListBox1.Selected(lItem) = False
End If
Next
ws.Range("C65536").End(xlToRight) = Left(strList, Len(strList) - 2)
End Sub

[Larren]

Private Sub cmdSubmit_Click()
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("KMS")
Dim lItem As Long

'find first empty row in database
iRow = ws.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row

For lItem = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(lItem) = True Then
ws.Range("C65536").End(xlUp)(2, 1) = ListBox1.List(lItem)
ListBox1.Selected(lItem) = False
End If
Next

This code is placing it all on different lines, when I tried the codes provided it's not pulling any of the selected information to the spread sheet. do you have any other ideas?? Thank you for your help

[Norie]

Larren

The code worked fine for me.

Can you attach a sample workbook?

[Larren]

Thank you so much for looking at this, I've probably got something messed up somewhere else causing the conflict I just don't know where.:dunno

[lucas]

code in attachment is password protected....

[Norie]

Larren

The VBA project is password protected in the attachment.:bug:

[Larren]

sorry about that, the pw is aspect

[Norie]

Larren

No it's not.:(

[mdmackillop]

Try Aspect

[Norie]

Larren

Did you actually change the code?

Have a look in IV65536.

By the way what does the add-in do, except cause Excel to slow down.:bug:

[mdmackillop]

For lItem = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(lItem) = True Then
txt = txt & ListBox1.List(lItem) & ", "
ListBox1.Selected(lItem) = False
End If
Next

ws.Range("C65536").End(xlUp)(2, 1) = Left(txt, Len(txt) - 2)

[Larren]

:115: sorry Norie, mdmackillop has it right it's Aspect

[Larren]

Norie,

I just copied and pasted what had been posted when nothing transfered I put back in what I had

The add-in was a requirement from my manager, I didn't have much of a choice on that one

[Larren]

mdmackillop,,,,Thank you, Thank you that did it. You all are wonderful I can't thank you enough for your help:mbounce: :bigkiss: