All selected listbox values to a cell?

[HK]

I am afraid I don't know much about VBA or programming. What I have tried to
do is to find pieces of VBA code in the net and then try to see if it works
for me. What I'd need the multiselect ActiveX listbox to do is that all the
values selected are saved in the active cell.

What I've managed to do so far with this piece of code is that I get a
listbox activated when I double clicks in a cell which contains a validation
list. When I click on the CommandButton1, only the first value which is
selected is transfered to the active cell. How could I get also the rest of
the values transfered to the same cell?

Harri

'==========================
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
Cancel As Boolean)
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Dim wsList As Worksheet
Set ws = ActiveSheet
Set wsList = Sheets("ValidationLists")

Cancel = True
Set cboTemp = ws.OLEObjects("ListBox1")
On Error Resume Next
With cboTemp
'clear and hide the combo box
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
End With
On Error GoTo errHandler
If Target.Validation.Type = 3 Then
'if the cell contains a data validation list
Application.EnableEvents = False
'get the data validation formula
str = Target.Validation.Formula1
str = Right(str, Len(str) - 1)
With cboTemp
'show the combobox with the list
.Visible = True
.Left = Target.Left
.Top = Target.Top
.Width = Target.Width + 45
.Height = Target.Height + 100
.ListFillRange = str
.LinkedCell = Target.Address
End With
cboTemp.Activate
End If

errHandler:
Application.EnableEvents = True
Exit Sub

End Sub
--------------
Private Sub CommandButton1_Click()
Dim i As Long
For i = 0 To Me.ListBox1.ListCount - 1
If Me.ListBox1.Selected(i) Then
ActiveCell.Value = Me.ListBox1.List(i)
ActiveCell.Offset(1, 0).Select
End If
Next i
End Sub

[Toppers]

Hi,

Try this:

Private Sub CommandButton1_Click()
Dim i As Long
For i = 0 To Me.ListBox1.ListCount - 1
If Me.ListBox1.Selected(i) Then
' values delimited by blank .. change as required
ActiveCell.Value = AciveCell & Me.ListBox1.List(i) & " "
End If
Next i
End Sub


"HK" wrote:

> I am afraid I don't know much about VBA or programming. What I have tried to
> do is to find pieces of VBA code in the net and then try to see if it works
> for me. What I'd need the multiselect ActiveX listbox to do is that all the
> values selected are saved in the active cell.
>
> What I've managed to do so far with this piece of code is that I get a
> listbox activated when I double clicks in a cell which contains a validation
> list. When I click on the CommandButton1, only the first value which is
> selected is transfered to the active cell. How could I get also the rest of
> the values transfered to the same cell?
>
> Harri
>
> '==========================
> Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
> Cancel As Boolean)
> Dim str As String
> Dim cboTemp As OLEObject
> Dim ws As Worksheet
> Dim wsList As Worksheet
> Set ws = ActiveSheet
> Set wsList = Sheets("ValidationLists")
>
> Cancel = True
> Set cboTemp = ws.OLEObjects("ListBox1")
> On Error Resume Next
> With cboTemp
> 'clear and hide the combo box
> .ListFillRange = ""
> .LinkedCell = ""
> .Visible = False
> End With
> On Error GoTo errHandler
> If Target.Validation.Type = 3 Then
> 'if the cell contains a data validation list
> Application.EnableEvents = False
> 'get the data validation formula
> str = Target.Validation.Formula1
> str = Right(str, Len(str) - 1)
> With cboTemp
> 'show the combobox with the list
> .Visible = True
> .Left = Target.Left
> .Top = Target.Top
> .Width = Target.Width + 45
> .Height = Target.Height + 100
> .ListFillRange = str
> .LinkedCell = Target.Address
> End With
> cboTemp.Activate
> End If
>
> errHandler:
> Application.EnableEvents = True
> Exit Sub
>
> End Sub
> --------------
> Private Sub CommandButton1_Click()
> Dim i As Long
> For i = 0 To Me.ListBox1.ListCount - 1
> If Me.ListBox1.Selected(i) Then
> ActiveCell.Value = Me.ListBox1.List(i)
> ActiveCell.Offset(1, 0).Select
> End If
> Next i
> End Sub
>
>
>