S
Shane
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
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