Can I modify my excel vba drag/drop code so values are populated from a listbox to a worksheet, other listbox “shows” the values?

[C4Vicious]

Hi all,

I originally posted this at stack overflow. I figured I would try here as well. I am running windows 8 and excel 2010.

I have some code that drags/drops records from listbox1 to listbox2 (On a form), and then populates a worksheet from the records in listbox2. The problem is that I need listbox2 to also populate the records from the worksheet on listbox2 when the form is activated. If I set listbox2's rowsource property to the range of the worksheet, I can no longer add records to listbox2.
If possible, I would like to modify my code (already pieced from several sources and modified) to bypass the step where the record is populated on listbox2.
I.e. I want the record to be dropped from listbox1 onto listbox2 and populate on the worksheet. Listbox2 would then populate the values of the worksheet via the rowsource property.
I am a vb/vba beginner and I have searched for days for a solution to this problem I greatly appreciate any help. This will be used as a tool for scheduling maintenance work orders.
Here is a link to the file for reference and the relevant code is here:

<code style="margin: 0px; padding: 0px; border: 0px; vertical-align: baseline; font-family: Consolas, Menlo, Monaco, 'Lucida Console', 'Liberation Mono', 'DejaVu Sans Mono', 'Bitstream Vera Sans Mono', 'Courier New', monospace, serif;">Private Sub ListBox1_MouseMove(ByVal Button As _ Integer, ByVal Shift As Integer, ByVal X As _ Single, ByVal Y As Single)Dim MyDataObject As DataObjectIf Button = 1 Then On Error Resume Next Set MyDataObject = New DataObject Dim Effect As Integer MyDataObject.SetText ListBox1.Value Effect = MyDataObject.StartDragEnd IfEnd SubPrivate 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 = TrueEffect = 1End SubPrivate 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 intI As IntegerDim intJ As IntegerCancel = TrueEffect = 1Worksheets("Monday").ActivateDim I As Integer'copy items selected to new list box With ListBox2 For I = 0 To ListBox1.ListCount - 1 If ListBox1.Selected(I) = True Then .AddItem ListBox1.List(I, 0) 'Add column 1 value .List(.ListCount - 1, 1) = ListBox1.List(I, 1) 'Add column 2 value .List(.ListCount - 1, 2) = ListBox1.List(I, 2) 'Add column 3 value End If Next IEnd With'If checkbox to clear listbox on drop is checked, records in listbox one will unhilight after dropIf Worksheets("Control Panel").Range("FU1") = True Then Dim intX As Integer For intX = 0 To ListBox1.ListCount - 1 If ListBox1.Selected(intX) = True Then ListBox1.Selected(intX) = False End If NextEnd If'Copy items from the list box to the worksheetFor intI = 1 To ListBox2.ListCount For intJ = 1 To ListBox2.ColumnCount Worksheets("Monday").Cells(intI + 1, intJ) = ListBox2.List(intI - 1, intJ - 1) Next intJNext intIEnd Sub</code></pre>

 

[C4Vicious]

When I pasted that code it didn't look like a huge block of text. Sorry...

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 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 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 intI As Integer
Dim intJ As Integer

Cancel = True
Effect = 1

Worksheets("Monday").Activate


Dim I As Integer


'copy items selected to new list box
With ListBox2
For I = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(I) = True Then
.AddItem ListBox1.List(I, 0) 'Add column 1 value
.List(.ListCount - 1, 1) = ListBox1.List(I, 1) 'Add column 2 value
.List(.ListCount - 1, 2) = ListBox1.List(I, 2) 'Add column 3 value
End If
Next I
End With

'If checkbox to clear listbox on drop is checked, records in listbox one will unhilight after drop
If Worksheets("Control Panel").Range("FU1") = True Then
Dim intX As Integer
For intX = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(intX) = True Then
ListBox1.Selected(intX) = False
End If
Next
End If

'Copy items from the list box to the worksheet
For intI = 1 To ListBox2.ListCount
For intJ = 1 To ListBox2.ColumnCount
Worksheets("Monday").Cells(intI + 1, intJ) = ListBox2.List(intI - 1, intJ - 1)
Next intJ
Next intI

End Sub

 

[C4Vicious]

Can anyone help with this? I'm stuck.