Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
listbox multiple selections
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
listbox multiple selections
Hi Paul
I have had a look at your code but it got a little confusing to I worked from your description in the hope that you will be able to work the code into your project making the alterations to fit. To test set up a Userform with two multiselect listboxes called ListBox4 and ListBox9 and a button below each of the listboxes to launch the code, they should be named ListBox4Button and ListBox9Button. Then Paste the following code into the userform module. It works by first passing the items selected in the list into the next available cell in either column C or E depending on which List you are working from. It will also pass the values and list indexes of the selected items into an array (one for each, I could have put both into a single array but I find this gets confusing to keep track of) It will then look for the value in the corresponding column and remove it and load the value into the opposite ListBox. Lastly it will remove the selected values from the original ListBox. If you have trouble let me know and I will comment the code and try to help. P.S. you will need values in the columns C, D to check against or you will get an error. I suppose this could be trapped using onerror. Also in the lines ReDim ValueArr(0 To 100) & ReDim IndexArr(0 To 100) ensure that you replace 100 with a number greater than you expect the array to get, i.e. a possible 154 maximum items in a list use 160 or so. Option Explicit Dim i, NewRow, Elm As Integer Dim Ctrl1, Ctrl2 As Control Dim Counter As Integer Dim ValueArr As Variant Dim IndexArr As Variant Dim FoundCell As Range Private Sub ListBox4Button_Click() NewRow = [E65535].End(xlUp).Row + 1 Set Ctrl1 = ListBox4 Set Ctrl2 = ListBox9 Call MovingStuff End Sub Private Sub ListBox9Button_Click() NewRow = [C65535].End(xlUp).Row + 1 Set Ctrl1 = ListBox9 Set Ctrl2 = ListBox4 Call MovingStuff End Sub Sub MovingStuff() Elm = 0 ReDim ValueArr(0 To 100) ReDim IndexArr(0 To 100) For i = 0 To Ctrl1.ListCount - 1 If Ctrl1.Selected(i) = True Then If Ctrl1.Name = "ListBox4" Then Cells(NewRow, 5).Value = Ctrl1.List(i) Else Cells(NewRow, 3).Value = Ctrl1.List(i) End If NewRow = NewRow + 1 ValueArr(Elm) = Ctrl1.List(i) IndexArr(Elm) = i Elm = Elm + 1 End If Next ReDim Preserve ValueArr(0 To Elm) ReDim Preserve IndexArr(0 To Elm) For i = 0 To Elm If Ctrl1.Name = "ListBox4" Then Set FoundCell = Worksheets("Sheet5").[C:C].Find _ (What:=ValueArr(i), LookAt:=xlWhole) Else Set FoundCell = Worksheets("Sheet5").[E:E].Find _ (What:=ValueArr(i), LookAt:=xlWhole) End If FoundCell.Delete Shift:=xlUp Ctrl2.AddItem (ValueArr(i)) Next Counter = 0 For i = 0 To UBound(IndexArr) - 1 Ctrl1.RemoveItem (IndexArr(i) - Counter) Counter = Counter + 1 Next End Sub Hope this helps Steve |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Creating Chart from Userform ListBox selections | Charts and Charting in Excel | |||
Capturing Listbox Selections | Excel Programming | |||
How do I retrieve multiple selections from a forms listbox? | Excel Programming | |||
Display selections from a listbox in a message box | Excel Programming | |||
Jumping to chart based on listbox selections | Excel Programming |