Kapat

Excel VBA Drag & Drop Between List Boxes

excel  listbox context menu Listbox Popup Menu

We have a userform consisting of three list boxes and button.
The sheets that created the workbook are listed on the first listbox(Listbox1) as listbox items. When clicked the sheet names on Listbox1 , content of the sheets are displayed on other listbox (Listbox2).

excel listbox drag drop Listbox1 items can be dragged and dropped into Listbox3 on the right. Three VBA Listbox events are used the dragging and dropping the listbox item : These are MouseMove, BeforeDragOver and BeforeDropOrPaste. The listbox drag and drop operation starts at the MouseMove event. Listbox items to be copied or moved are copied to a DataObject object. Mouse drag is generated by the BeforeDragOver event. The drop operation is generated by the BeforeDropOrPaste event.

Excel vba listbox drag drop
Private Sub ListBox1_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
        On Error Resume Next
        Set MyDataObject = New DataObject
        Dim Effect As Integer
        MyDataObject.SetText ListBox1.Value
        Effect = MyDataObject.StartDrag
    End If
End Sub

Private Sub ListBox3_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)
Cancel = True
Effect = 1
End Sub

Private Sub ListBox3_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)
Dim deger As String, m As Integer
Cancel = True
Effect = 1
deger = ListBox1.Value
'With the For-Next loop, it checks whether the item already exists.
For m = 0 To ListBox3.ListCount - 1
    If deger = CStr(ListBox3.List(m)) Then
        MsgBox "This item already exists in ListBox3", vbCritical, ""
    Exit Sub
    End If
Next
ListBox3.AddItem Data.GetText
End Sub

If VBA codes above are examined, it is seen that if the item to be moved already exists, a warning is given with msgbox and no action is taken. Thus, the duplicate recording is prevented.

excel listbox context right click menu We created a listbox context (right-click) menu that working on the Listbox3. There are four menu items in the menu that displayed when right-clicking on Listbox3 :
✔️ Increase Font Size excel listbox context menu
✔️ Decrease Font Size
✔️ Sort A-Z
✔️ Remove From List
✔️ Remove All

excel listbox popup menu

We added a class to VBE (Visual Basic Editor) to create the listbox context (right click) menu. Codes of this class : vba class sample excel vba class module

Public LBox As MSForms.ListBox
Public WithEvents IncreaseFont As CommandBarButton
Public WithEvents DecreaseFont As CommandBarButton
Public WithEvents DeleteFromList As CommandBarButton
Public WithEvents DeleteAll As CommandBarButton

Private Sub DeleteFromList_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
If LBox.ListIndex >= 0 Then
    LBox.RemoveItem LBox.ListIndex
End If
End Sub

Private Sub DeleteAll_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
    LBox.Clear
End Sub

Private Sub IncreaseFont_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
    LBox.Font.Size = LBox.Font.Size + 1
    LBox.IntegralHeight = False
End Sub
Private Sub DecreaseFont_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
    LBox.Font.Size = LBox.Font.Size - 1
End Sub
Private Sub SortList_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
   Dim j, i As Integer, temp As Variant

    With LBox
    For i = 0 To .ListCount - 2
            For j = i + 1 To .ListCount - 1
                If .List(i) > .List(j) Then
                    temp = .List(j)
                    .List(j) = .List(i)
                    .List(i) = temp
                End If
            Next j
        Next i
    End With
End Sub

When the codes above are examined, it is seen that the buttons in the class and macros that are triggered when these buttons are clicked are created : vba create button in class
IncreaseFont , DecreaseFont , SortList , DeleteFromList , DeleteAll buttons.

We have added the following codes to top of the userform’s codes :
Private Const evnPopupMenu = "ListboxMenu"
Private MyListboxMenu As evnClass

Also ,we introduced listbox context menu items to the Userform_Initialize procedure : vba userform initialize

Private Sub UserForm_Initialize()
Dim i As Byte
...
...
Set MyListboxMenu = New evnClass
Application.CommandBars(evnPopupMenu).Delete
With CommandBars.Add(evnPopupMenu, Position:=msoBarPopup)
    
   With .Controls.Add(Type:=msoControlButton)
        .Caption = "Increase Font Size"
        .BeginGroup = True
        .FaceId = 403
    End With
     With .Controls.Add(Type:=msoControlButton)
        .Caption = "Decrease Font Size"
        .BeginGroup = True
        .FaceId = 404
    End With
     With .Controls.Add(Type:=msoControlButton)
        .Caption = "Sort A-Z"
        .BeginGroup = True
        .FaceId = 210
    End With
    With .Controls.Add(Type:=msoControlButton)
        .Caption = "Remove From List"
        .BeginGroup = True
        .FaceId = 2087
    End With
    With .Controls.Add(Type:=msoControlButton)
        .Caption = "Remove All"
        .BeginGroup = False
        .FaceId = 1019
    End With
    
    Set MyListboxMenu.IncreaseFont = .Controls(1)
    Set MyListboxMenu.DecreaseFont = .Controls(2)
    Set MyListboxMenu.SortList = .Controls(3)
    Set MyListboxMenu.DeleteFromList = .Controls(4)
    Set MyListboxMenu.DeleteAll = .Controls(5)
   
    Set MyListboxMenu.LBox = Me.ListBox3
End With
End Sub

Finally,we added the following codes to the Listbox3 MouseDown procedure : vba listbox mousedown
Private Sub ListBox3_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 2 Then
Application.CommandBars(evnPopupMenu).ShowPopup
End If
End Sub

excel list sheets on listbox When the userform is opened, the workbook’s sheets are listed automatically on Listbox1. To achieve this, we added the following codes to the Userform_Initialize procedure :
For i = 1 To ThisWorkbook.Sheets.Count
ListBox1.AddItem Sheets(i).Name
Next i
vba list worksheets on listbox

The content of the selected sheet is shown as columns in Listbox2 when any of the listed worksheets in Listbox1 is selected . vba show sheet content on listbox

VBA codes in ListBox1_Click procedure that provided us to show sheet content on listbox : vba show sheet content on listbox
Dim sq, m As Integer
sq = ThisWorkbook.Sheets(ListBox1.Text).UsedRange.Rows
m = ThisWorkbook.Sheets(ListBox1.Text).UsedRange.Rows.Count
With ListBox2
.List = sq
.ColumnCount = m
End With

excel create new workbook from selected sheet When the button below the userform is clicked, a new workbook is created only containing the listed sheets on Listbox3. VBA codes that provided this : vba create new workbook

Private Sub CommandButton1_Click()
Dim X, s, i, n, K As Integer
Dim OurNewWorkbook As Workbook

If ListBox3.ListCount > 0 Then
Set OurNewWorkbook = Workbooks.Add
s = ListBox3.ListCount
n = 1
For X = 0 To ListBox3.ListCount - 1  'Sheets are copied into the new workbook that created.
ThisWorkbook.Sheets(ListBox3.List(X, 0)).Copy OurNewWorkbook.Sheets(n)
n = n + 1
Next X
Else
MsgBox "No Items On The Listbox.", vbApplicationModal, ""
Exit Sub
End If

K = OurNewWorkbook.Sheets.Count

'If there is any sheet other than the copied sheets in new workbook, it is deleted using for-next loop.
For i = K To 1 Step -1       
If Sheets(i).Index > Sheets(s).Index Then
Application.DisplayAlerts = False
Sheets(i).Delete
Application.DisplayAlerts = True
End If

Next
End Sub
vba create new workbook

📥 Download sample workbook that contained userform