Hi,

I've got some code that I use for transferring listbox values from the
listbox to a worksheet and at the same time to another listbox as well. The
chosen values are also being transferred in a different worksheet, this
worksheet is used as a source for the listboxes, the original values are in
Column A, copies of these values are in Column C and after a value is chosen
it will be deleted from column C and added to column E. This because when I
reopen the document I can load the chosen values from these columns for
displaying in the listboxes. This complete process is reversible, check code.

The codes I'm using are;

For the listbox to chose from;

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

With Worksheets(2).Range("A1:A32763")
Set c = .FIND(ListBox1.Value, After:=[A32763], LookIn:=xlValues)

If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Cells.Offset(0, 4) = c.Value
Loop While Not c Is Nothing And c.Address < firstAddress
End If
End With

With Worksheets(2).Range("C1:C32763")
Set d = .FIND(ListBox1.Value, After:=[C32763], LookIn:=xlValues)

If Not d Is Nothing Then
firstAddress = d.Address
Do
d.Cells.Clear
Loop While Not d Is Nothing And d.Address < firstAddress
d.Cells.Delete
End If
End With

ActiveCell = ListBox1.Value

For Each Item In ActiveCell
TDL.ListBox7.AddItem Item
Next Item

With ListBox1
If .ListIndex = 0 Then
.RemoveItem .ListIndex
.ListIndex = -1
End If
End With

Label1.Caption = "X: " & (ListBox1.ListCount)
Label7.Caption = "Allocated " & (ListBox7.ListCount)

ActiveCell.Offset(0, 1).Activate

End Sub

And this one for the listbox for the already chosen values;

Private Sub ListBox7_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

With Worksheets(2).Range("A1:A32763")
Set c = .FIND(ListBox7.Value, After:=[A32763], LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Cells.Offset(0, 2).Insert
c.Cells.Offset(0, 2) = c.Value
Loop While Not c Is Nothing And c.Address < firstAddress
End If
End With

With Worksheets(2).Range("E1:E32763")
Set e = .FIND(ListBox7.Value, After:=[E32763], LookIn:=xlValues)
If Not e Is Nothing Then
firstAddress = e.Address
Do
e.Cells.Clear
Loop While Not e Is Nothing And e.Address < firstAddress
e.Cells.Delete
End If
End With

With Worksheets(2).Range("F1:F32763")
Set g = .FIND(ListBox7.Value, After:=[F32763], LookIn:=xlValues)
If Not g Is Nothing Then
firstAddress = g.Address
Do
g.Cells.Clear
Loop While Not g Is Nothing And g.Address < firstAddress
g.Cells.Delete
End If
End With

With Worksheets(1).Range("E5:E200")
Set f = .FIND(ListBox7.Value, After:=[E200], LookIn:=xlValues)
If Not f Is Nothing Then
firstAddress = f.Address
Do
f.Cells.Value = ""
Loop While Not f Is Nothing And f.Address < firstAddress
End If
End With

ActiveCell.Offset(0, 15) = ListBox7.Value

For Each Item In ActiveCell.Offset(0, 15)
TDL.ListBox1.AddItem Item, (c.Row - 1)
Next Item

ActiveCell.Offset(0, 15).Delete

With ListBox7
If .ListIndex = 0 Then
.RemoveItem .ListIndex
.ListIndex = -1
End If
End With

Label7.Caption = "Allocated: " & (ListBox7.ListCount)
Label1.Caption = "X: " & (ListBox1.ListCount)

End Sub


Above codes are working great but now I would like to do the same thing with
a multiselection listbox. I can set up the listbox to be a multiselection
one, that's the easy part. I would like to do exactly the same with the
multivalues as with the single values.

I would like that the first value of the selection goes into the activecell
and the last values of the selection goes into the activecell + 1 column (so
propably via an offset(0,1)). this via a commandbutton.

I would like that all the selected items to be moved from listbox4 to
listbox9.
I would like that all the selected items to be removed from worksheets(5)
column C and entered in column E.
I would like to be able to reverse these actions by doing the actions the
other way around.

Hope anybody can help me with this.

Cheers,

Paul