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 Rhinorhino 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
Joined
Apr 23, 2006
Messages
89
Location
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

Submeg
  • Locked
  • Question Question
Selecting shapes based on its name and then arranging them in a circle
Replies
2
Views
458
Andrzejek
Andrzejek
Andrzejek
  • Locked
  • Question Question
Copy data between SQL and Oracle
Replies
8
Views
2K
remeng
remeng
jtm2020hyo
  • Locked
  • Question Question
VBA script to split 0D, 1D, and 2D arrays
Replies
10
Views
1K
jtm2020hyo
jtm2020hyo
feipezi
  • Locked
  • Question Question
How to detect dups and/or sum by group?
Replies
1
Views
484
Andrzejek
Andrzejek
AncientTiger
  • Locked
  • Question Question
How to screenshot a userform and save the capture as JPG
Replies
7
Views
3K
AncientTiger
AncientTiger

Part and Inventory Search

Sponsor

Back
Top