Most Valuable Professional


View Jan Karel Pieterse's profile on LinkedIn subscribe to rss feed
Subscribe in a reader

Subscribe to our mailing list

* indicates required

Audit !!!

Check out our RefTreeAnalyser
the ultimate Excel formula auditing tool.

Trainings

Excel VBA Masterclass (English)
Excel VBA for Financials (Dutch)

Third party tools

Speed up your file

FastExcel
The best tool to optimise your Excel model!

What has changed?

PerfectXL Compare, for Spreadsheet Comparison
This Excel compare tool is fast, reliable, and easy to use. Compare two Excel files now and see for yourself!
Home > English site > Articles > Drag And Drop

Enabling Drag and Drop between two Listboxes on a VBA Userform

Introduction

One of the more difficult tasks in VBA programming is to enable drag and drop between two listboxes on a userform. There is an article on the Microsoft site about this that kind of gets you half-way there, but it does not work if you have the listbox setup to allow selecting more than one item. To make it easy to enable drag and drop between two listboxes on a userform I wrote a class module which you can simply insert into your VBA project. After doing that, it only takes about 8 lines of code to get it working.

This is what it looks like:

Demo of dragdrop class

I have prepared a demo file for you!

Working principle

If you want to implement Drag and Drop between controls (or within a control) on a userform, these control events are needed:

MouseMove

When the left mouse button is down while the mouse is moved, it is likely the user is starting a drag operation. We need to make sure the currently selected items of the list are remembered.

I want the code to enable drag and drop both between the two controls and within a control and I want to indicate where the drop will take place. I therefore need two things:

  1. A way to remember which list items were selected when I started the drag

    The code temporarily marks the items we're dragging by adding this bit of string in front of each selected item: "> ". This bit of string will later determine which items must be removed from the list after the drop has been done. If the user drags without a mousebutton held down, the "> " is removed from the list items to clean up.

  2. A way to indicate the drop location

    VBA does not make it easy to detect what list item is under the mouse cursor. The MouseMove and BeforeDropOrPaste events do give an X and Y coordinate, but determining which item "belongs" to a certain Y isn't easy as we do not know the Y coordinate of each item. The trick I used: temporarily add 40 list items to the listbox (to make sure the entire height of the box is used up by list items), then set the topindex of the listbox to the last one. This forces the listbox to scroll down, displaying the last item at the bottom of the listbox. The listbox then gets a new TopIndex (of the item actually displaying at the top) so we can now count how many items fit into the listbox' height. We can thus calculate the height of an individual item and use that to detect where our mouse is. You'll find the code that does this in the Property Set procedure belonging to ListBox1.

     Trick to get the height of an item in the listbox

BeforeDragOver

The BeforeDragOver event is used to make sure the mouse pointer changes shape so the user has a visual indication whether or not he can drop items on that listbox. The class contains two boolean properties DragWithin1 and DragWithin2 which you can set to False if you want to disable drag withing either listbox.

BeforeDropOrPaste

This is where the magic happens, the code checks if there is anything to drop and if so, first adds the dragged items to the listbox and subsequently removes all marked items from the (other) listbox.

The code

Code needs to go in two places to enable drag and drop in your userform: In the code window behind the userform and in a separate class module called clsDragDrop you must insert into the VBAProject.

Userform

The userform has two listboxes (with their default names ListBox1 and ListBox2). All it takes to implement the drag and drop is these lines of code in the userform's code module:

Option Explicit

'Holds the instance of the drag and drop class
Private mcDragDrop As clsDragDrop

Private Sub UserForm_Initialize()
    '------Start of lines just for our demo------
    Dim lCt As Long
    'Just add some items so we have something to drag
    For lCt = 0 To 5
        Me.ListBox1.AddItem "Item " & lCt
    Next
    '------End of lines just for our demo------
    
    'Instantiate our class
    Set mcDragDrop = New clsDragDrop
    With mcDragDrop
        'Tell it which listboxes to work with
        Set mcDragDrop.ListBox1 = Me.ListBox1
        Set mcDragDrop.ListBox2 = Me.ListBox2
        'Enable drag and drop within both listboxes
        .DragWithin1 = True
        .DragWithin2 = True
    End With
End Sub

Private Sub UserForm_Terminate()
    Set mcDragDrop = Nothing
End Sub

Note that the part between "Start of lines just for our demo" and "End of lines just for our demo" is only there to add some items to the listbox for demonstration purposes, you'd remove that or replace it with your own code that populates controls on your form.

The clsDragDrop class

I decided to explain the code by inserting comments. I'm not adding more explanation here so I hope this is clear enough!

Note that most event routines are very short. They just contain a call to an associated method. This is because all aforementioned events come in pairs, one for each ListBox. The code for needed for each event is identical and hence private methods are called to handle them.

Here is the entire code inside the class module clsDragDrop, fully commented:

'---------------------------------------------------------------------------------------
' File   : clsDragDrop
' Author : Jan Karel Pieterse
' (c)    : Copyright JKP Application Development Services, all rights reserved
' Date   : 9-6-2020
' Purpose: Enable drag and drop between two listboxes
'---------------------------------------------------------------------------------------

Option Explicit

'Used to determine list item under mouse when dropping
Private mlListItemCount As Long
Private mdListItemSize As Double

'the listbox we dragged items from
Private mobjFromList As MSForms.ListBox

Private Const lLEFTMOUSEBUTTON As Long = 1

Private WithEvents moListBox1 As MSForms.ListBox
Private WithEvents moListBox2 As MSForms.ListBox

'These two determine whether or not we are allowed to drag inside the controls:
Private mbDragWithin1 As Boolean
Private mbDragWithin2 As Boolean

'---------------------Events---------------------

Private Sub Class_Terminate()
    Set moListBox1 = Nothing
    Set moListBox2 = Nothing
End Sub

Private Sub moListBox1_MouseMove(ByVal Button As Integer, _
                                 ByVal Shift As Integer, _
                                 ByVal X As Single, _
                                 ByVal Y As Single)
    HandleMouseMove moListBox1, Button, Shift, X, Y
End Sub

Private Sub moListBox2_MouseMove(ByVal Button As Integer, _
                                 ByVal Shift As Integer, _
                                 ByVal X As Single, _
                                 ByVal Y As Single)

    HandleMouseMove moListBox2, Button, Shift, X, Y
End Sub

Private Sub moListBox1_BeforeDragOver(ByVal Cancel As MSForms.ReturnBoolean, _
                                      ByVal Data As MSForms.DataObject, _
                                      ByVal X As Single, _
                                      ByVal Y As Single, _
                                      ByVal DragState As MSForms.fmDragState, _
                                      ByVal Effect As MSForms.ReturnEffect, _
                                      ByVal Shift As Integer)
    
    HandleBeforeDragOver moListBox1, Cancel, Data, X, Y, DragState, Effect, Shift
End Sub

Private Sub moListBox2_BeforeDragOver(ByVal Cancel As MSForms.ReturnBoolean, _
                                      ByVal Data As MSForms.DataObject, _
                                      ByVal X As Single, _
                                      ByVal Y As Single, _
                                      ByVal DragState As MSForms.fmDragState, _
                                      ByVal Effect As MSForms.ReturnEffect, _
                                      ByVal Shift As Integer)

    'Note the order of the first two arguments:
    HandleBeforeDragOver moListBox2, Cancel, Data, X, Y, DragState, Effect, Shift
End Sub

Private Sub moListBox1_BeforeDropOrPaste(ByVal Cancel As MSForms.ReturnBoolean, _
                                         ByVal Action As MSForms.fmAction, _
                                         ByVal Data As MSForms.DataObject, _
                                         ByVal X As Single, _
                                         ByVal Y As Single, _
                                         ByVal Effect As MSForms.ReturnEffect, _
                                         ByVal Shift As Integer)

    'Note the order of the first two arguments:
    HandleBeforeDropOrPaste moListBox1, moListBox2, Cancel, Action, Data, X, Y, Effect, Shift
End Sub

Private Sub moListBox2_BeforeDropOrPaste(ByVal Cancel As MSForms.ReturnBoolean, _
                                         ByVal Action As MSForms.fmAction, _
                                         ByVal Data As MSForms.DataObject, _
                                         ByVal X As Single, _
                                         ByVal Y As Single, _
                                         ByVal Effect As MSForms.ReturnEffect, _
                                         ByVal Shift As Integer)
    
    HandleBeforeDropOrPaste moListBox2, moListBox1, Cancel, Action, Data, X, Y, Effect, Shift
End Sub

'---------------------Methods---------------------

Private Sub HandleMouseMove(ByRef localListbox As Object, _
                            ByVal Button As Integer, _
                            ByVal Shift As Integer, _
                            ByVal X As Single, _
                            ByVal Y As Single)
    Dim objData As DataObject
    Dim lEffect As Long
    Dim lCt As Long
    Dim lclicked As Long
    Dim sSelected As String
    If Button = lLEFTMOUSEBUTTON Then
        With localListbox
            'Detect on which item we last clicked
            'This is because if you first click 3 items and then initiate your drag by
            'clicking on the middle one, VBA unchecks the one you clicked on
            lclicked = .TopIndex + Int(Y / mdListItemSize)
            If lclicked >= .ListCount Then lclicked = .ListCount
            If lclicked < 0 Then lclicked = 0
            For lCt = 0 To .ListCount - 1
                If .Selected(lCt) Then
                    .Selected(lCt) = False
                    'Build a list of the items we're about to drag
                    sSelected = sSelected & "|" & lCt & Chr(222) & .List(lCt)
                    'We add a small marker in front of each dragged item
                    'This makes it easier to later recognize the ones that need to be removed from the listbox
                    'After the drop has been done
                    If Not .List(lCt) Like "[>] *" Then
                        .List(lCt) = "> " & .List(lCt)
                    End If
                ElseIf lCt = lclicked Then
                    'The one where we clicked might be deselected, but we always want to include that one with the drag
                    sSelected = sSelected & "|" & lCt & Chr(222) & .List(lCt)
                    If Not .List(lCt) Like "[>] *" Then
                        .List(lCt) = "> " & .List(lCt)
                    End If
                End If
            Next
            'If any items were selected, add them to the clipboard
            If Len(sSelected) > 0 Then
                Set mobjFromList = localListbox
                Set objData = New DataObject
                objData.SetText sSelected
                'Now initiate the actual drag
                lEffect = objData.StartDrag
            End If
        End With
    ElseIf Button = 0 Then
        'clean up our temporarily added '> ' markings
        With localListbox
            For lCt = .ListCount - 1 To 0 Step -1
                If .List(lCt) Like "[>] *" Then
                    .List(lCt) = Replace(.List(lCt), "> ", "")
                End If
            Next
        End With
    End If
End Sub

Private Sub HandleBeforeDragOver(localListbox As Object, _
                                 ByVal Cancel As MSForms.ReturnBoolean, _
                                 ByVal Data As MSForms.DataObject, _
                                 ByVal X As Single, _
                                 ByVal Y As Single, _
                                 ByVal DragState As MSForms.fmDragState, _
                                 ByVal Effect As MSForms.ReturnEffect, _
                                 ByVal Shift As Integer)
    Dim lTo As Long
    Dim lCt As Long
    Cancel = True
    'This bit only changes the mouse cursor to indicate whether drop is allowed
    If mobjFromList Is localListbox Then
        If Right(localListbox.Name, 1) = 1 Then
            'We're in ListBox1, decide on dropeffect
            If DragWithin1 Then
                Effect = fmDropEffectMove
            Else
                Effect = fmDropEffectNone
            End If
        Else
            'We're in ListBox2, decide on dropeffect
            If DragWithin2 Then
                Effect = fmDropEffectMove
            Else
                Effect = fmDropEffectNone
            End If
        End If
    Else
        Effect = fmDropEffectMove
    End If
    'Indicate where we'll be pasting
    With localListbox
        lTo = .TopIndex + Int(Y / mdListItemSize)
        If lTo >= .ListCount Then lTo = .ListCount
        If lTo < 0 Then lTo = 0
        For lCt = 0 To .ListCount - 1
            If lCt = lTo Then
                .Selected(lCt) = True
            Else
                .Selected(lCt) = False
            End If
        Next
    End With
End Sub

Private Sub HandleBeforeDropOrPaste(localListbox1 As Object, _
                                    localListbox2 As Object, _
                                    ByVal Cancel As MSForms.ReturnBoolean, _
                                    ByVal Action As MSForms.fmAction, _
                                    ByVal Data As MSForms.DataObject, _
                                    ByVal X As Single, _
                                    ByVal Y As Single, _
                                    ByVal Effect As MSForms.ReturnEffect, _
                                    ByVal Shift As Integer)
    Dim lTo As Long
    Dim lCt As Long
    Dim sSelected As String
    Dim vSel As Variant

    sSelected = Data.GetText
    vSel = Split(sSelected, "|")
    Cancel = True
    If mobjFromList Is localListbox2 Then
        'We arrive here when we drag from ListBox2 to ListBox1
        'Determine where we let go of our mouse, insert the items above this list item
        With localListbox1
            lTo = .TopIndex + Int(Y / mdListItemSize)
            If lTo >= .ListCount Then lTo = .ListCount
            If lTo < 0 Then lTo = 0
        End With
        'Add the dragged items at the indicated location
        For lCt = UBound(vSel) To 1 Step -1
            localListbox1.AddItem Replace(Split(vSel(lCt), Chr(222))(1), "> ", ""), lTo
        Next
        'Now delete the ones we dragged from the list
        With localListbox2
            For lCt = .ListCount - 1 To 0 Step -1
                .Selected(lCt) = False
                If .List(lCt) Like "[>] *" Then
                    .RemoveItem lCt
                End If
            Next
        End With
    ElseIf DragWithin1 Then
        With localListbox1
            'Now we're dragging within the same ListBox
            'Determine where we let go of our mouse, insert the items above this list item
            lTo = .TopIndex + Int(Y / mdListItemSize)
            If lTo >= .ListCount Then lTo = .ListCount
            If lTo < 0 Then lTo = 0
            'Add the dragged items at the indicated location
            For lCt = UBound(vSel) To 1 Step -1
                .AddItem Replace(Split(vSel(lCt), Chr(222))(1), "> ", ""), lTo
            Next
            'Now delete the ones we dragged from the list
            For lCt = .ListCount - 1 To 0 Step -1
                .Selected(lCt) = False
                If .List(lCt) Like "[>] *" Then
                    .RemoveItem lCt
                End If
            Next
        End With
    End If
    Set mobjFromList = Nothing
End Sub

'---------------------Property let/set and gets---------------------

Public Property Get ListBox1() As MSForms.ListBox
    Set ListBox1 = moListBox1
End Property

Public Property Set ListBox1(ByVal oNewValue As MSForms.ListBox)
    Dim lCt As Long
    Set moListBox1 = oNewValue
    'The code below is used to temporarily fill the listbox with 40 items.
    'This is used to be able to determine which item of the list is under the mouse pointer when we drop
    With moListBox1
        For lCt = 1 To 40
            .AddItem lCt
        Next
        .TopIndex = .ListCount - 1
        mlListItemCount = .ListCount - .TopIndex
        mdListItemSize = .Height / mlListItemCount
        For lCt = 1 To 40
            .RemoveItem .ListCount - 1
        Next
    End With
End Property

Public Property Get ListBox2() As MSForms.ListBox
    Set ListBox2 = moListBox2
End Property

Public Property Set ListBox2(ByVal oNewValue As MSForms.ListBox)
    Set moListBox2 = oNewValue
End Property

Public Property Get DragWithin1() As Boolean
    DragWithin1 = mbDragWithin1
End Property

Public Property Let DragWithin1(ByVal bNewValue As Boolean)
    mbDragWithin1 = bNewValue
End Property

Public Property Get DragWithin2() As Boolean
    DragWithin2 = mbDragWithin2
End Property

Public Property Let DragWithin2(ByVal bNewValue As Boolean)
    mbDragWithin2 = bNewValue
End Property

Remaining issues

Not everything works to my liking yet. I am still trying to find a solution for these issues:


Comments

All comments about this page:


Comment by: rasa (14-6-2020 23:30:00)

hi, how to create a non boxes forms in excel with vba.
and how to show 2 or more forms together and beside of other in excel.

 


Comment by: Jan Karel Pieterse (15-6-2020 11:38:00)

Hi Rasa,

I'm not sure I understand what you mean, can you please try to explain with more detail?

 


Comment by: rasa (22-6-2020 10:07:00)

hi,
excuse me.i think this code is too long .its can be more simple.but i have 2 difficult question.please help me.

1)how to create a non boxes forms with vba in excel.
2)how to show 2 or more user forms together with vba in excel.



thanks,for support.

 


Comment by: Jan Karel Pieterse (22-6-2020 10:29:00)

Hi Rasa,

I'm interested to learn where my code could be shortened.

I'm not sure what you mean by a non-boxes form?

You can show two userforms as long as you make sure you show both using the vbModeless argument.

 


Have a question, comment or suggestion? Then please use this form.

If your question is not directly related to this web page, but rather a more general "How do I do this" Excel question, then I advise you to ask your question here: www.eileenslounge.com.

Please enter your name (required):

Your e-mail address (optional, will only be used to inform you when your comment is published or to respond to your question directly):

Your request or comment (max 2000 characters):

To post VBA code in your comment, use [VB] tags, like this: [VB]Code goes here[/VB].

I give permission to process this data and display my name and my comment on this website accoring to our Privacy Policy.