Exchanging Values Between Two ListBoxes.

[Rawce]

Hello,

I have two listboxes on a form, one which holds a master list and the
other the selections I have made. Basically, as I click on values from
the master list I want it to disappear from the master and appear in
the selected list (and vice versa). Initially, the master will be
fully populated, but eventually some of the selections will be moved
over to the selected list. Currently I do this by reading from a
global list in a hidden sheet and, depending on which listbox the
entry should be in, populate the correct listbox. These values are
written to a named sheet range each time (as this helps greatly with
sorting) by capturing the _Click event on both of the listboxes.

My first problem is this; on the first click the _Click routine
effectively fires twice and therefore the entry underneath the one
selected moves across to the other listbox as well as the one
selected. This only happens the first time I click on the listbox as
all subsequent clicks only move the line selected. I've tried to
capture the first time it initialises the _Click by setting a status
flag to False when the form loads and using an IF statement in the
_Click routine to prevent it running the first time, but this means
that all subsequent clicks need to be performed twice to get it to
run. Any help would be much appreciated on this one as both
workarounds don't produce satisfactory results. I can post code if you
think it'll help.

My second problem also involves these listboxes, but is more of an
annoyance. Assuming that the above problem was solved, I'd like to be
able to select an entry on ListBoxA, watch it jump over to ListBoxB
and be able to select the entry below on ListBoxA to do the same.
However, when I click to move an item the item below is automatically
highlighted (in blue) and is unselectable, which means I have to click
a different item, then the one I want and finally unselect the other
one from the other list which might remove two entries if I can't
solve the problem above! If anyone knows how to unhighlight on the
_Click event, I'd appreciate it. I have tried the
UserForm.ListBox1.Selected(i) = True/False, but that didn't seem to do
anything. Is there a way of refreshing ListBoxes without having to
reinitialise the form each time?

Cheers,

Ross.

 

[Tom Ogilvy]

two listboxes and two buttons that move items between the lists

Commandbutton1 - from listbox1 to listbox2
CommandButton2 - from Listbox2 to listbox1

Private Sub CommandButton1_Click()
Dim theList As Variant
For i = ListBox1.ListCount - 1 To 0 Step -1
If ListBox1.Selected(i) = True Then
ListBox2.AddItem ListBox1.List(i), 0
ListBox1.Selected(i) = False
ListBox1.RemoveItem i
End If
Next i
theList = ListBox2.List
QuickSort theList, LBound(theList), UBound(theList)
ListBox2.Clear
ListBox2.List = theList
End Sub

Private Sub CommandButton2_Click()
Dim theList As Variant
For i = ListBox2.ListCount - 1 To 0 Step -1
If ListBox2.Selected(i) = True Then
ListBox1.AddItem ListBox2.List(i), 0
ListBox2.Selected(i) = False
ListBox2.RemoveItem i
End If
Next i
theList = ListBox1.List
QuickSort theList, LBound(theList), UBound(theList)
ListBox1.Clear
ListBox1.List = theList
End Sub

Private Sub CommandButton3_Click()
Me.Hide
End Sub

Private Sub UserForm_Initialize()
Dim theList As Variant
Listbox1.RowSource = ""
Listbox2.RowSource = ""
theList = Worksheets("sheet1").Range("A1:A15")
QuickSort theList, LBound(theList, 1), UBound(theList, 1)
ListBox1.List = theList
ListBox2.Clear
End Sub

Sub QuickSort(SortArray, L, R)
'
'Posted by Jim Rech 10/20/98 Excel.Programming
'Modified to sort on first column of a two dimensional array
'
Dim i, j, X, Y
i = L
j = R
X = SortArray((L + R) / 2, LBound(SortArray, 2))

While (i <= j)
While (SortArray(i, LBound(SortArray, 2)) < X And i < R)
i = i + 1
Wend
While (X < SortArray(j, LBound(SortArray, 2)) And j > L)
j = j - 1
Wend
If (i <= j) Then
Y = SortArray(i, LBound(SortArray, 2))
SortArray(i, LBound(SortArray, 2)) = SortArray(j,
LBound(SortArray, 2))
SortArray(j, LBound(SortArray, 2)) = Y
i = i + 1
j = j - 1
End If
Wend
If (L < j) Then Call QuickSort(SortArray, L, j)
If (i < R) Then Call QuickSort(SortArray, i, R)
End Sub

 

[Rawce]

Many thanks, Tom. For ease of use I've tried avoiding having to a)
select the item then b) click a button to move it, but the very quick
way you've responded seems to indicate it can't be done the way I'm
trying to do by using the _Click event. Is this the case?

I've bypassed the need for sorting by re-writing the values to the
listbox each time by looping through the list on the hidden sheet and
text searching for the entry in the 'selected' listbox and replacing
it if found or placing it in the 'master' listbox if not. This
(coupled with a partial text search on a unique number) also means I
can update the list (e.g. spelling or a title change) automatically
and the 'master' or 'selected' values will also get updated next time
the form is loaded. I was expecting a bit of a time penalty, but it's
pretty much instant (and maybe even quicker than a bubble sort) so
I'll leave it that way.

Cheers,

Ross.

 

[Tom Ogilvy]

If you use the click event, you move one item.

Private fReEntry As Boolean

Private Sub TeamAddsListBox_Click()
If fReEntry Then Exit Sub
fReEntry = True
TeamListBox2.AddItem TeamAddsListBox.Value
TeamAddsListBox.RemoveItem TeamAddsListBox.ListIndex
fReEntry = False
End Sub

Private Sub TeamAddsListBox_MouseDown( _
ByVal Button As Integer, _
ByVal Shift As Integer, _
ByVal X As Single, ByVal Y As Single)
TeamAddsListBox.ListIndex = -1
End Sub

Private Sub UserForm_Initialize()
TeamAddsListBox.AddItem "Item1"
TeamAddsListBox.AddItem "Item2"
TeamAddsListBox.AddItem "Item3"
TeamAddsListBox.AddItem "Item4"
TeamAddsListBox.AddItem "Item5"

End Sub

This is from another thread, but I have tested the code and it works. The
code in the mousedown event allows the TeamAddsListbox to be emptied. The
private variable at the top of the userform module keeps the click event
from being recalled when the item is removed.

 

[Rawce]

Many thanks again. I'll work it into my code and let you know how I
get on. I did look into the MouseDown, but couldn't get it to do
anything, but I was probably missing something, maybe not using both
the _MouseDown and _Click events together.

Cheers,

Ross.

 

[Rawce]

Many thanks again. I'll work it into my code and let you know how I
get on. I did look into the MouseDown, but couldn't get it to do
anything, but I was probably missing something, maybe not using both
the _MouseDown and _Click events together.

Cheers,

Ross.

Works fine as you have it, thanks. However, as soon as I write to the
cell it seems to fire twice but it's not always guaranteed, which is a
bit strange. What I'll probably have to do is use a clickable listbox
(as you've done it) and then get the user to hit a save button to
write the values to the cell then rebuild the list.

Anyone got any suggestions on the second issue wrt to the highlighting
problem?

Cheers,

Ross.

 

[Jim Tibbetts]

Tom - I didn't know whether to post this in this thread or the one you have
been helping me in. So I will post it in both. I figured that my problem with
a name being added out of the TeamListBox range would be solved by sorting
the list to move blanks to the bottom. Your code to Rawce seemed like it
should do that. However, I get an error and it flags QuickSort saying "Sub or
Function not defined". How do I define QuickSort?

Thanks

 

[Tom Ogilvy]

Quicksort was at the bottom of the post, but here it is again:

Sub QuickSort(SortArray, L, R)
'
'Posted by Jim Rech 10/20/98 Excel.Programming
'Modified to sort on first column of a two dimensional array
'
Dim i, j, X, Y
i = L
j = R
X = SortArray((L + R) / 2, LBound(SortArray, 2))

While (i <= j)
While (SortArray(i, LBound(SortArray, 2)) < X And i < R)
i = i + 1
Wend
While (X < SortArray(j, LBound(SortArray, 2)) And j > L)
j = j - 1
Wend
If (i <= j) Then
Y = SortArray(i, LBound(SortArray, 2))
SortArray(i, LBound(SortArray, 2)) = _
SortArray(j, LBound(SortArray, 2))
SortArray(j, LBound(SortArray, 2)) = Y
i = i + 1
j = j - 1
End If
Wend
If (L < j) Then Call QuickSort(SortArray, L, j)
If (i < R) Then Call QuickSort(SortArray, i, R)
End Sub

 

[Tom Ogilvy]

Anyone got any suggestions on the second issue wrt to the highlighting

problem?

That is what the mousedown event allows you to do. The item will still be
highlighted, but you can click it. Maybe you didn't try it or removed the
mousedown event.

 

[Rawce]

That is what the mousedown event allows you to do. The item will still be

highlighted, but you can click it. Maybe you didn't try it or removed the
mousedown event.

Ah, thanks. I thought the mousedown was to capture the double clicking
issue. I'll try it again when I get the opportunity. Busy with other
things at the moment and have run out of budget for this job so I'll
be doing it at lunchtime or after work. Will report back, hopefully
with some success.

Cheers,

Ross.

 

[Rawce]

Finally managed to get back to this, but on a different project. To
stop all the problems I had to use the following (couldn't be bothered
with any sorting as bubble sorts always seemed to throw up a null
value in the sTemp2 array). This gets rid of the random clicking issue
(click the third entry and the fifth moves across), the double moving
issue (a random event where sometimes two entries would be swapped)
and the highlighting issue mentioned above:

Public bDesignSelectEntry, bDesignPickEntry As Boolean
Public iPicked As Integer
Public strPicked As String

Private Sub UserForm_Activate()
bDesignSelectEntry = False
bDesignPickEntry = False
iPicked = 0
strPicked = ""
' Subroutines to populate the DesignPick and DesignSelect ListBoxes
also go here.
End Sub

Private Sub DesignPick_Click()
If bDesignPickEntry Then Exit Sub
bDesignPickEntry = True
iPicked = MRSForm.DesignPick.ListIndex
strPicked = MRSForm.DesignPick.List(iPicked, 0)
MRSForm.DesignSelect.AddItem strPicked
MRSForm.DesignPick.RemoveItem iPicked
bDesignPickEntry = False
iPicked = 0
strPicked = ""
End Sub

Private Sub DesignPick_MouseDown(ByVal Button As Integer, ByVal Shift
As Integer, ByVal X As Single, ByVal Y As Single)
MRSForm.DesignPick.ListIndex = -1
bDesignPickEntry = False
iPicked = 0
strPicked = ""
End Sub

Private Sub DesignSelect_Click()
If bDesignSelectEntry Then Exit Sub
bDesignSelectEntry = True
iPicked = MRSForm.DesignSelect.ListIndex
strPicked = MRSForm.DesignSelect.List(iPicked, 0)
MRSForm.DesignPick.AddItem strPicked
MRSForm.DesignSelect.RemoveItem iPicked
bDesignSelectEntry = False
iPicked = 0
strPicked = ""
End Sub

Private Sub DesignSelect_MouseDown(ByVal Button As Integer, ByVal
Shift As Integer, ByVal X As Single, ByVal Y As Single)
MRSForm.DesignSelect.ListIndex = -1
bDesignSelectEntry = False
iPicked = 0
strPicked = ""
End Sub

I think by using integers (iPicked) and strings (strPicked) helps
specify which list items has been selected and then these values can
be eliminated (set to 0 and "") at each time so everything's fresh for
the next click. Seems convoluted, but it also seems to work. Hope it's
of use to someone. Thanks to Tom and others for their efforts.

Cheers,

Ross.

 

[Rawce]

Actually, I lied. The double clicking issue is still happening and I
can't see any way around it. I'll have to inform the users to watch
out for it.