I need to figure out the code to concatenate multiple selections from
a list box into one cell with a comma as a divider.

This is what I have pieced together from a few sources so far. I get
an error when running this, so I know it doesn't work. Any help would
be appreciated.

Private Sub OK_exp_Click()
Dim CellRange As Range
Dim CellCnt As Integer
Dim r As Integer
Dim x As Range
Dim w As String
Dim y As Range
Dim z As Range
Dim sbuf As String


w = ", "
'z = Range("Sheet2!A1")

CellCnt = 0
For r = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(r) Then
CellCnt = CellCnt + 1
If CellCnt = 1 Then
Set CellRange = ActiveSheet.UsedRange.Cells(r + 1)
Else
Set CellRange = Union(CellRange,
ActiveSheet.UsedRange.Cells(r + 1))
End If
End If
Next r
For Each y In CellRange
If Len(y.Text) 0 Then sbuf = sbuf & y.Text & w
Next
z = Left(sbuf, Len(sbuf) - 1)
ActiveCell.Value = z
Unload Me

End Sub

It would help to know which line is throwing the error and what the error is.
However, the following snippet probably would throw and error because you
are trying to form a union with an undefined range. If the else statement
executes, it is because CellRange was not set in the first part of the if
statement and therefore it is still undefined so you might get a type
mismatch or something similar to tell you it can't form the union, or it will
ignore it altogether.

Else
Set CellRange = Union(CellRange,
ActiveSheet.UsedRange.Cells(r + 1))

I also do not see where you have assigned a value to sbuf prior to using is
as part of it's own value. So that will probably throw an error also.

If Len(y.Text) 0 Then sbuf = sbuf & y.Text & w

Your CelCnt counter needs to be moved from the beginning of the For ... Next
Loop to the end as in the following example.

For r = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(r) Then
If CellCnt = 1 Then
Set CellRange = ActiveSheet.UsedRange.Cells(r + 1)
Else
Set CellRange = Union(CellRange,
ActiveSheet.UsedRange.Cells(r + 1))
End If
End If
CellCnt = CellCnt + 1
Next r

Maybe if you could define what you want to do with a little more detail,
someone could offer a better suggestion.


"Shane" wrote:

I need to figure out the code to concatenate multiple selections from
a list box into one cell with a comma as a divider.

This is what I have pieced together from a few sources so far. I get
an error when running this, so I know it doesn't work. Any help would
be appreciated.

Private Sub OK_exp_Click()
Dim CellRange As Range
Dim CellCnt As Integer
Dim r As Integer
Dim x As Range
Dim w As String
Dim y As Range
Dim z As Range
Dim sbuf As String


w = ", "
'z = Range("Sheet2!A1")

CellCnt = 0
For r = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(r) Then
CellCnt = CellCnt + 1
If CellCnt = 1 Then
Set CellRange = ActiveSheet.UsedRange.Cells(r + 1)
Else
Set CellRange = Union(CellRange,
ActiveSheet.UsedRange.Cells(r + 1))
End If
End If
Next r
For Each y In CellRange
If Len(y.Text) 0 Then sbuf = sbuf & y.Text & w
Next
z = Left(sbuf, Len(sbuf) - 1)
ActiveCell.Value = z
Unload Me

End Sub

It was throwing me the error on the z= left... line

The message that it was giving me was
Run-time error '5':


Invalid procedure call or argument


What I want to do is take a list put it in a list box, select multiple
selections and then have them paste into one cell with a comma as a
divider.

I have the list box and the checkmarks. The hard part for me is the
code to do what I described above.

Thanks for your help






On Aug 16, 7:03 pm, JLGWhiz wrote:
It would help to know which line is throwing the error and what the error is.
However, the following snippet probably would throw and error because you
are trying to form a union with an undefined range. If the else statement
executes, it is because CellRange was not set in the first part of the if
statement and therefore it is still undefined so you might get a type
mismatch or something similar to tell you it can't form the union, or it will
ignore it altogether.

Else
Set CellRange = Union(CellRange,
ActiveSheet.UsedRange.Cells(r + 1))

I also do not see where you have assigned a value to sbuf prior to using is
as part of it's own value. So that will probably throw an error also.

If Len(y.Text) 0 Then sbuf = sbuf & y.Text & w

Your CelCnt counter needs to be moved from the beginning of the For ... Next
Loop to the end as in the following example.

For r = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(r) Then
If CellCnt = 1 Then
Set CellRange = ActiveSheet.UsedRange.Cells(r + 1)
Else
Set CellRange = Union(CellRange,
ActiveSheet.UsedRange.Cells(r + 1))
End If
End If
CellCnt = CellCnt + 1
Next r

Maybe if you could define what you want to do with a little more detail,
someone could offer a better suggestion.



"Shane" wrote:
I need to figure out the code to concatenate multiple selections from
a list box into one cell with a comma as a divider.

This is what I have pieced together from a few sources so far. I get
an error when running this, so I know it doesn't work. Any help would
be appreciated.

Private Sub OK_exp_Click()
Dim CellRange As Range
Dim CellCnt As Integer
Dim r As Integer
Dim x As Range
Dim w As String
Dim y As Range
Dim z As Range
Dim sbuf As String

w = ", "
'z = Range("Sheet2!A1")

CellCnt = 0
For r = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(r) Then
CellCnt = CellCnt + 1
If CellCnt = 1 Then
Set CellRange = ActiveSheet.UsedRange.Cells(r + 1)
Else
Set CellRange = Union(CellRange,
ActiveSheet.UsedRange.Cells(r + 1))
End If
End If
Next r
For Each y In CellRange
If Len(y.Text) 0 Then sbuf = sbuf & y.Text & w
Next
z = Left(sbuf, Len(sbuf) - 1)
ActiveCell.Value = z
Unload Me

End Sub- Hide quoted text -

- Show quoted text -