Need help with code for drag and drop

J

jamielill

Active Member
Joined
Jul 27, 2009
Messages
286
The following code will allow you to drag and drop items between two listboxs It copys the item from one listbox to another then deletes it from the source listbox were it is copyed from.
What is happing if you click twice on a item in a list box it makes a copy in the list box. I do not desire this effect.
Can anybody help with code for this.
Thanks
Jamie
Private Sub UserForm_Initialize()

'add the numbers 1 to 3 to each listbox
Dim i As Long
For i = 1 To 3
ListBox1.AddItem i
ListBox2.AddItem i
Next i
End Sub

'ListBox Control, DataObject Object, MouseMove Event, StartDrag, SetText Methods Example
'The following example demonstrates a drag-and-drop operation from one
'ListBox to another using a DataObject to contain the dragged text.
'This code sample uses the SetText and StartDrag methods in the MouseMove event
'to implement the drag-and-drop operation.
'To use this example, copy this sample code to the Declarations portion of a form.
'Make sure that the form contains two ListBox controls named ListBox1 and ListBox2.

Private Sub ListBox1_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)
Dim i As Long
Cancel = True
Effect = 1
ListBox1.AddItem Data.GetText
With Me.ListBox2
For i = 1 To .ListCount
If .List(i - 1, 0) = Data.GetText Then
.RemoveItem i - 1
Exit For
End If
Next i
End With
End Sub
Private Sub ListBox2_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)
Dim i As Long
Cancel = True
Effect = 1
ListBox2.AddItem Data.GetText
With Me.ListBox1
For i = 1 To .ListCount
If .List(i - 1, 0) = Data.GetText Then
.RemoveItem i - 1
Exit For
End If
Next i
End With
End Sub
Private Sub ListBox1_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 ListBox2_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 ListBox1_MouseMove(ByVal Button As Integer, _
ByVal Shift As Integer, _
ByVal X As Single, _
ByVal Y As Single)
Dim MyDataObject As DataObject
Dim Effect As Integer
If Button = 1 Then
Set MyDataObject = New DataObject
If Me.ListBox1.Text = "" Then
Exit Sub
End If
MyDataObject.SetText ListBox1.Value
Effect = MyDataObject.StartDrag
End If

End Sub
Private Sub ListBox2_MouseMove(ByVal Button As Integer, _
ByVal Shift As Integer, _
ByVal X As Single, _
ByVal Y As Single)
Dim MyDataObject As DataObject
Dim Effect As Integer
If Button = 1 Then
Set MyDataObject = New DataObject
If Me.ListBox2.Text = "" Then
Exit Sub
End If
MyDataObject.SetText ListBox2.Value
Effect = MyDataObject.StartDrag
End If

End Sub
 

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
Sort by date Sort by votes
Hi Jamie. Your code will be much easier to read if placed within code tags. There's probably more than a couple of ways to do this. I simply set a reference to the listbox where the drag initiated and refused the drop if the source and destination are one in the same.

Here are the additions...

<b>In the general declarations region up top...</b>
Private DragSource As msforms.ListBox

<b>Private Sub ListBox1_MouseMove(...</b>
Set DragSource = ListBox1

<b>Private Sub ListBox2_MouseMove(...</b>
Set DragSource = ListBox2

<b>Private Sub ListBox1_BeforeDropOrPaste(...</b>
If DragSource Is ListBox1 Then Exit Sub

<b>Private Sub ListBox2_BeforeDropOrPaste(...</b>
If DragSource Is ListBox2 Then Exit Sub


<b>Complete code listing:</b>
Code: 
Private DragSource As msforms.ListBox

Private Sub UserForm_Initialize()

    'add the numbers 1 to 3 to each listbox
    Dim i As Long
    
    For i = 1 To 3
        ListBox1.AddItem i
        ListBox2.AddItem i
    Next i
End Sub

'ListBox Control, DataObject Object, MouseMove Event, StartDrag, SetText Methods Example
'The following example demonstrates a drag-and-drop operation from one
'ListBox to another using a DataObject to contain the dragged text.
'This code sample uses the SetText and StartDrag methods in the MouseMove event
'to implement the drag-and-drop operation.
'To use this example, copy this sample code to the Declarations portion of a form.
'Make sure that the form contains two ListBox controls named ListBox1 and ListBox2.

Private Sub ListBox1_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)
    
    Dim i As Long
    
    If DragSource Is ListBox1 Then Exit Sub
    Cancel = True
    Effect = 1
    ListBox1.AddItem Data.GetText
    
    With Me.ListBox2
        For i = 1 To .ListCount
            If .List(i - 1, 0) = Data.GetText Then
                .RemoveItem i - 1
                Exit For
            End If
        Next i
    End With
    
End Sub

Private Sub ListBox2_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)
    
    Dim i As Long
    
    If DragSource Is ListBox2 Then Exit Sub
    Cancel = True
    Effect = 1
    ListBox2.AddItem Data.GetText
    
    With Me.ListBox1
        For i = 1 To .ListCount
            If .List(i - 1, 0) = Data.GetText Then
                .RemoveItem i - 1
                Exit For
            End If
        Next i
    End With
End Sub

Private Sub ListBox1_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 ListBox2_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 ListBox1_MouseMove(ByVal Button As Integer, _
    ByVal Shift As Integer, _
    ByVal X As Single, _
    ByVal Y As Single)
    Dim MyDataObject As DataObject
    
    Dim Effect As Integer
    
    If Button = 1 Then
        Set DragSource = ListBox1
        Set MyDataObject = New DataObject
        If Me.ListBox1.Text = "" Then
            Exit Sub
        End If
        MyDataObject.SetText ListBox1.Value
        Effect = MyDataObject.StartDrag
    End If

End Sub

Private Sub ListBox2_MouseMove(ByVal Button As Integer, _
    ByVal Shift As Integer, _
    ByVal X As Single, _
    ByVal Y As Single)
    
    Dim MyDataObject As DataObject
    Dim Effect As Integer
    
    If Button = 1 Then
        Set DragSource = ListBox2
        Set MyDataObject = New DataObject
        If Me.ListBox2.Text = "" Then
            Exit Sub
        End If
        MyDataObject.SetText ListBox2.Value
        Effect = MyDataObject.StartDrag
    End If

End Sub
 
Upvote 0
Thanks a lot Tom This was very helpful. As being realitvy new to VBA somtime this can be overwhelming.Maybe you could help me out with this one. Using the above code if I had to accsess 24 listboxs for drag and dropping. How much code is involved if it not to in depth any chance you could give me hand with the code
J
 
Upvote 0
Only 24? :)

There might be a better design at hand. Tell me about your project at least to the degree that the many, many listboxes are needed.
 
Upvote 0
What I have is a userform with 24 listboxs. They represent a family of products. The user of excel must have the ability to drag and drop between these groups as this allows him to vary the discount structure of the product.
Eg.
Today item 1 is in group one he must change the discount of this item so he just drags it to group three. This must be varied once or twice a day to be competative in the ever changing automotive markert. The user can type it in but it is much faster to drag and drop a 30 character item code from one box to another.

These 24 groups are sub groups of a 500+ list. Which means to say there are 500 customers. The user clicks on customer C moves the items around in the list boxs. It calculates the discount and he then closes the workbook or he does this for 20 customers
 
Last edited:
Upvote 0
Ok. What are the rules governing the drag and drop. The scope that applies to all of your listboxes. We established that we do no want to allow a drag and drop within the same control. What other rule(s) apply?

1. You can drag from any to any?
2. You can drag from Group1 to Group2?
3. ???

You can write code in a class module to compensate for all of your controls but I don't know what the constraints are. I need to know exactly what you need as far as the definition of a valid drag and drop.
 
Upvote 0
I just need to be able to drap and drop from any listbox to any listbox. Pretty much that is it.
No multiple items one at a time as the current code does
J
 
Upvote 0
J.

Add a class module to your project named: ListBoxDragAndDropManager
Paste in this code:
Code: 
Option Explicit

Private WithEvents pThisListBox As MSForms.ListBox

Friend Property Set ThisListBox(Ctrl As MSForms.ListBox)
    Set pThisListBox = Ctrl
End Property

Friend Property Get ThisListBox() As MSForms.ListBox
    Set ThisListBox = pThisListBox
End Property

Private Sub Class_Terminate()
    Set DragSource = Nothing
    Set pThisListBox = Nothing
End Sub

Private Sub pThisListBox_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)
    
    Dim i As Long
    
    If DragSource Is pThisListBox Then Exit Sub
    Cancel = True
    Effect = 1
    pThisListBox.AddItem Data.GetText
    
    With DragSource
        For i = 1 To .ListCount
            If .List(i - 1, 0) = Data.GetText Then
                .RemoveItem i - 1
                Exit For
            End If
        Next i
    End With
    
End Sub

Private Sub pThisListBox_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 pThisListBox_MouseMove(ByVal Button As Integer, _
    ByVal Shift As Integer, _
    ByVal x As Single, _
    ByVal Y As Single)
    Dim MyDataObject As DataObject
    
    Dim Effect As Integer
    
    If Button = 1 Then
        Set DragSource = pThisListBox
        Set MyDataObject = New DataObject
        If pThisListBox.Text = "" Then
            Exit Sub
        End If
        MyDataObject.SetText pThisListBox.Value
        Effect = MyDataObject.StartDrag
    End If

End Sub

Declare a public variable to a standard module:
Code: 
Public DragSource As MSForms.ListBox

Add this code to any userform containing two or more listboxes:
Code: 
Option Explicit

Private LBs As Collection

Private Sub UserForm_Initialize()
    Dim lb As MSForms.ListBox
    Dim LMB As ListBoxDragAndDropManager
    
    Set LBs = New Collection
    For Each lb In Me.Controls
        Set LMB = New ListBoxDragAndDropManager
        Set LMB.ThisListBox = lb
        LBs.Add LMB
    Next
    
End Sub

Download the example if you have any problems...
<A HREF="http://cid-ea73b3a00e16f94f.skydrive.live.com/self.aspx/Mr%20Excel%20Example/ListBoxDragAndDropManager.zip" TARGET="_blank">Example Workbook: ListBoxDragAndDropManager.xls.zip</A>
 
Upvote 0
Why so much code?

I know you can write code to drag and drop between controls but it just seems bit much to me.

Why do you have 24 listboxes?

Perhaps a better approach.:)
 
Upvote 0
Tom that was absolutly :pamazing:p. Thank you very much for helping me out with this code. Now I have to go line by line and figure out what you did. Most of the code is to advanced for me so it will take me awhile to figure this out.
Again, Thanks for helping.
One day I think i will get this programming thing

Jamie
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question
PNG
Replies
1
Views
286
Dan_W
D
A
  • Solved
Calendar form cancel button passing data to worksheet
Replies
7
Views
470
AndyEd
A
I
  • Question
Listbox not being populate when code is run
Replies
4
Views
322
ipbr21054
I
M
  • Question
drag and drop listbox that updates at worksheet
Replies
2
Views
625
monvarona
M
C
  • Question
A Bookmark to return to the same row when exiting and opening the application
Replies
8
Views
194
Edgar_
Edgar_

Forum statistics

Threads
1,215,655
Messages
6,126,053
Members
449,283
Latest member
GeisonGDC

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top