movement of list box data

[rewclaus]

Hi, I was hoping someone could help me with a problem. I want to have a list box (call it lst1) that I can move data from to another list box (let's call it newlst). However, if the data I move is already in the newlst I want the lst to redisplay the list but with a x # after the item.

e.g.:

If newlst and lst1 have data called "card1", and I want to transfer the "card1" data from lst1 to newlst, then I want newlst to display "card1 x 2".

Can anyone help me?

 

[FractalWalk]

I'm no expert but it seems that you have multiple things going on here. One is removing a piece of data form a list and the other is conditionally changing or adding the data in another list. You didn't mention the event that will move the data (e.g. drag-drop, button click etc.), which is something you need to define. Also can the destination data be x3, x4 etc?

I'll assume a button called MoveIt will handle the job and that you can have > x2 in the list.

Private Sub MoveIt_Click
fnd = 0 ' set flag
for a=1 to newlst.ListCount ' loop through each item in the new list
b=Split(newlst.List(a-1)," x ") 'separate the string in case the item has a xN sufffix
If lst1=b(0) then ' If the root matches the item being moved
n=2 ' the default xN equals 2 unless the following condition applies
If ubound(b)>0 then n = val(b(Ubound(b)))+1 'if the suffix already exists then increment it 1.
newlst.List(a-1)=b(0) & " x " & n 'replace with new string
fnd=1
exit for
endif
next a
If fnd = 0 then newlst.additem lst1 'If no match was found then add the new item to the list
End Sub


I wrote this on the fly as I don't have access to VB right now, so I'm not sure that I typed everything correctly. But the general ideas should work.

 

[rewclaus]

Well actually I want to limit the x # to a max of 3. And a command button will be used, but I would prefer to just be able to dblClick the item in lst1. Something I should mention is that I don't want to remove the data from lst1, I just want to move it.

Thanks for what you have done Fractal!

 

[FractalWalk]

I had some very similar code, so I tweaked it and it worked for me.

The following 5 subroutines should get where you need to be. One is what I posted above modified to accept only up to " x 3" for the suffix. It is tied to a command button called "AddCriteria".

The remaining subs will allow you to move the data via double click or drag and drop. The data transfer is one way only (from lst1 to newlst) and the items remain in the lst1 listbox.



Private Sub lst1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Call AddCriteria_Click
End Sub


Private Sub AddCriteria_Click()
fnd = 0
For a = 1 To newlst.ListCount
b = Split(newlst.List(a - 1), " x")
If lst1 = b(0) Then
n = 2
If UBound(b) > 0 Then n = 3
newlst.List(a - 1) = lst1 & " x " & n
fnd = 1
Exit For
End If
Next a
If fnd = 0 Then newlst.AddItem lst1
End Sub


Private Sub newlst_BeforeDragOver(ByVal Cancel As _
MSForms.ReturnBoolean, ByVal Data As _
MSForms.DataObject, ByVal x As Single, _
ByVal y As Single, ByVal DragState As Long, _
ByVal Effect As MSForms.ReturnEffect, _
ByVal Shift As Integer)

Cancel = True
Effect = 1
End Sub


Private Sub newlst_BeforeDropOrPaste(ByVal _
Cancel As MSForms.ReturnBoolean, _
ByVal Action As Long, ByVal Data As _
MSForms.DataObject, ByVal x As Single, _
ByVal y As Single, ByVal Effect As _
MSForms.ReturnEffect, ByVal Shift As Integer)

Cancel = True
Effect = 1
newlst.AddItem Data.GetText
End Sub


Private Sub lst1_MouseMove(ByVal Button As _
Integer, ByVal Shift As Integer, ByVal x As _
Single, ByVal y As Single)
Dim MyDataObject As DataObject
If Button = 1 Then
Set MyDataObject = New DataObject
Dim Effect As Integer
MyDataObject.SetText lst1.Value
Effect = MyDataObject.StartDrag
End If
End Sub