Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations John Tel on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

drag and drop mulitcolumn info 1

Status
Not open for further replies.
WelshyWizard

WelshyWizard

IS-IT--Management
Apr 23, 2006
89
GB
Hi all,

I've got the following code which allows me to drag and drop muitiselected rows from one listbox to another. However, I the listbox I'm dragging from is multicolumn and I want all columns to be taken over in the drag, not just the 1st one (which is what is happening).

Code: 
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)
  
Cancel = True
  
Effect = fmDropEffectMove
  
Dim I
  
With ListBox1
  
For I = 0 To .ListCount - 1
  
If .Selected(I) Then
  
ListBox2.AddItem .List(I)
  
End If
  
Next
  
End With
  
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 I, cnt
  
If Button = 2 Then  'Use the right Mouse button to drag.
  
Set MyDataObject = New DataObject
  
Dim Effect As Integer
  
MyDataObject.SetText ListBox1.List(ListBox1.ListIndex)
  
Effect = MyDataObject.StartDrag
  
End If
  
End Sub

Any ideas how I do it?

Cheers

Today is the tomorrow you worried about yesterday - and all is well.....
 
Sort by date Sort by votes
WelshyWizard,
Try this, I started with the basic routine from the help file and added code to [tt]ListBox2_BeforeDropOrPaste[/tt], all additions in bold.
Code: 
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)
[b]Dim intColumn As Integer[/b]
Cancel = True
Effect = 1
[b][green]'Add the new row with the data from the first column[/green][/b]
ListBox2.AddItem Data.GetText
[b][green]'Add the additional column info if necessary
'NOTE: ColumnCount and ListCount are both Zero based so
'      [i]subtract one[/i] to get the real position[/green]
For intColumn = 1 To (Me.ListBox1.ColumnCount[i] - 1[/i])
  [green]'Make sure there are enough columns in destination[/green]
  If intColumn <= (Me.ListBox2.ColumnCount[i] - 1[/i]) Then
    ListBox2.List(Me.ListBox2.ListCount[i] - 1[/i], intColumn) = _
      Me.ListBox1.List(Me.ListBox1.ListIndex, intColumn)
  End If
Next intColumn[/b]
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
If Button = 1 Then
    Set MyDataObject = New DataObject
    Dim Effect As Integer
    MyDataObject.SetText ListBox1.List(Me.ListBox1.ListIndex)
    Effect = MyDataObject.StartDrag
End If
End Sub

Hope this helps,
CMP

[small]For the best results do what I'm thinking, not what I'm saying.[/small]
(GMT-07:00) Mountain Time (US & Canada)
 
Upvote 0 Downvote
Thanks CMP,

I've altered your code to deal with multiple selections and it works a treat. However, I spotted a slight hitch.

My code is as follows:
Code: 
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)
  
Cancel = True

With ListBox1

Dim i

For i = 0 To .ListCount - 1
  
If .Selected(i) Then
  
'Add the new row with the data from the first column
ListBox2.AddItem .List(i)
  
'Add the additional column info if necessary
'NOTE: ColumnCount and ListCount are both Zero based so
'      subtract one to get the real position
For intColumn = 1 To (Me.ListBox1.ColumnCount - 1)
  'Make sure there are enough columns in destination
  If intColumn <= (Me.ListBox2.ColumnCount - 1) Then
    ListBox2.List(Me.ListBox2.ListCount - 1, intColumn) = _
      Me.ListBox1.List(Me.ListBox1.ListIndex, intColumn)
  End If
Next intColumn
  
End If
  
Next
  
End With

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 i, cnt
  
If Button = 2 Then  'Use the right Mouse button to drag.
  
Set MyDataObject = New DataObject
  
Dim Effect As Integer
  
MyDataObject.SetText ListBox1.List(ListBox1.ListIndex)
  
Effect = MyDataObject.StartDrag
  
End If
  
End Sub

My problem is that in column 3, the value is a date. When dragged into Listbox2 it changes to a numberic date value.

How can I stop this happening?!

Thanks for all the help so far, it's much appreciate.

Today is the tomorrow you worried about yesterday - and all is well.....
 
Upvote 0 Downvote
WelshyWizard,
That's wierd, so we just hard code all three columns so we can apply formatting to the third (or is that 2nd?).
Code: 
Private Sub ListBox2_BeforeDropOrPaste...
[s]For intColumn = 1 To (Me.ListBox1.ColumnCount - 1)
  'Make sure there are enough columns in destination
  If intColumn <= (Me.ListBox2.ColumnCount - 1) Then[/s]
    ListBox2.List(Me.ListBox2.ListCount - 1, 1) = _
      Me.ListBox1.List(Me.ListBox1.ListIndex, 1)
    ListBox2.List(Me.ListBox2.ListCount - 1, 2) = _
      [b]Format([/b]Me.ListBox1.List(Me.ListBox1.ListIndex, 2)[b],"MM/DD/YYYY")[/b]
  [s]End If
Next intColumn[/s]
...
End Sub

CMP

[small]For the best results do what I'm thinking, not what I'm saying.[/small]
(GMT-07:00) Mountain Time (US & Canada)
 
Upvote 0 Downvote
Ok... I lied... My code isn't working a treat!

The first column is being filled in correctly with this code:
Code: 
ListBox2.AddItem .List(i)
however, for every row in listbox2 the additional columns are always being filled in with the info from the last selected row.

Code: 
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)
  
Cancel = True

With ListBox1

Dim i

For i = 0 To .ListCount - 1
  
If .Selected(i) Then
 
ListBox2.AddItem .List(i)
ListBox2.List(Me.ListBox2.ListCount - 1, 1) = _
      Me.ListBox1.List(Me.ListBox1.ListIndex, 1)
ListBox2.List(Me.ListBox2.ListCount - 1, 2) = _
      Format(Me.ListBox1.List(Me.ListBox1.ListIndex, 2),"MM/DD/YYYY")
ListBox2.List(Me.ListBox2.ListCount - 1, 3) = _
      Me.ListBox1.List(Me.ListBox1.ListIndex, 3)
ListBox2.List(Me.ListBox2.ListCount - 1, 4) = _
      Me.ListBox1.List(Me.ListBox1.ListIndex, 4)
ListBox2.List(Me.ListBox2.ListCount - 1, 5) = _
      Me.ListBox1.List(Me.ListBox1.ListIndex, 5)

End If
  
Next
  
End With

End Sub

Hmmm.. Is there anything you can think of which will remedy this?

Cheers

Today is the tomorrow you worried about yesterday - and all is well.....
 
Upvote 0 Downvote
WelshyWizard,
Since your looping through [tt]ListBox1[/tt] with [tt]i[/tt], you need to reference [tt]i[/tt] (not [tt]Me.ListBox1.ListIndex[/tt]) when your adding values to [tt]ListBox2[/tt].
Code: 
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)
Cancel = True
With ListBox1
  Dim i
  For i = 0 To .ListCount - 1
    If .Selected(i) Then
      ListBox2.AddItem .List(i)
      ListBox2.List(Me.ListBox2.ListCount - 1, 1) = .List(i, 1)
      ListBox2.List(Me.ListBox2.ListCount - 1, 2) = Format(.List(i, 2), "MM/DD/YYYY")
      ListBox2.List(Me.ListBox2.ListCount - 1, 3) = .List(i, 3)
      ListBox2.List(Me.ListBox2.ListCount - 1, 4) = .List(i, 4)
      ListBox2.List(Me.ListBox2.ListCount - 1, 5) = .List(i, 5)
    End If
  Next
End With
End Sub

Hope this helps,
CMP

[small]For the best results do what I'm thinking, not what I'm saying.[/small]
(GMT-07:00) Mountain Time (US & Canada)
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

Andrzejek
  • Locked
  • Question
Copy data between SQL and Oracle 1
Replies
8
Views
1K
remeng
remeng
jtm2020hyo
  • Locked
  • Question
VBA script to split 0D, 1D, and 2D arrays 1
Replies
10
Views
750
jtm2020hyo
jtm2020hyo
feipezi
  • Locked
  • Question
How to detect dups and/or sum by group?
Replies
1
Views
368
Andrzejek
Andrzejek
AncientTiger
  • Locked
  • Question
How to screenshot a userform and save the capture as JPG 1
Replies
7
Views
2K
AncientTiger
AncientTiger
thanhthanh12
  • Locked
  • Question
How disable save and save as in word vba?
Replies
1
Views
322
macropod
macropod

Part and Inventory Search

Sponsor

Back
Top