Using VBA for Drag-and-Drop Data entry

Hello. Here is my goal in its simplest form. 

I have a list of data in column A (for example, A5:A10). I have a row of boxes (merged cells) in row 2. I would like to write VBA code that would allow me to click on a piece of data from column A, "drag" it to one of the boxes (merged cells), and "drop" the value into that merged cell. Preferably the data in column A would be preserved.

 There's lots more going on - e.g., event macros, functions, conditional formatting, data validation - but this is the core problem.

Thanks in advance for any help you can provide.

Brent

I've had a bit of a play with this and come up with two possible solutions, both involving overlying shapes on cells

(1) 

I don't know how/if it's possible to detect drag & drop operation on cells - particularly given the default action is to select the 'dragged over' cells.

I have an alternate idea using transparent shapes over each of the 'source' cells (i.e. a5:a10).  By overlaying shapes over these cells, these may be dragged and dropped on to your merged cells.  Then you would just create a class for these shapes, hopefully they support a 'on move' or on click event, which would then allow you to use some math to determine where they've been dragged to, and where they came from.  YOu could then return the shape back to its original position, but update the 'row 2' cell value to reflect the 'selected' data item.

This is the formatting I used.

    ActiveSheet.Shapes.AddShape(msoShapeRectangle, 0#, 102#, 48#, 12.75).Select
    Selection.ShapeRange.Fill.Visible = msoTrue
    Selection.ShapeRange.Fill.Solid
    Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 0, 0)
    Selection.ShapeRange.Fill.Transparency = 1#
    Selection.ShapeRange.Line.Weight = 0.75
    Selection.ShapeRange.Line.Transparency = 0#
    Selection.ShapeRange.Line.Visible = msoTrue
    Selection.ShapeRange.Line.ForeColor.RGB = RGB(0, 0, 0)
    Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)

Note that using "No Fill" causes the click action to 'fall through' the shape to the underlying cell, hence the use of transparency.

(2)

Using the same shapes, you can use the 'OnAction' property of each shape to launch a macro when it is clicked.  Clicked, not dragged.  If the drag destination is always going to be the same, would clicking be just as good? If so, you may use the OnAction property, and pass a parameter which specifies which shape has been clicked.

Sub setShapeActions()
    Dim x As Shape
    For Each x In ActiveSheet.Shapes
        x.OnAction = "'" & "Module1.doDrag """ & "Cell A2" & """'"
    Next x
End Sub

Sub doDrag(xyz)
    MsgBox xyz & " was clicked"
End Sub

Clearly I haven't devised a whole solution, but it hopefully may lead you down a fruitful path of inquiry.

 Rick

Yeah, this is an idea I have toyed with as well, but couldn't get anywhere. You're post has indeed opened up a new line of thinking. Thanks!

Bg

 Brent, the simplest might be to get the user to double click on the cell to be dragged, and then click on the target cell. VBA can trap double clicks.

Anonymous:

...
I have a list of data in column A (for example, A5:A10). I have a row of boxes (merged cells) in row 2. I would like to write VBA code that would allow me to click on a piece of data from column A, "drag" it to one of the boxes (merged cells), and "drop" the value into that merged cell. Preferably the data in column A would be preserved.
...

OK, a few problems. You can't really do much with merged cells. One of the things you can't do with them is drag other cells and drop them onto merged cells. Excel simply doesn't permit it. On the other hand, you could unmerge these cells, set horizontal alignment to centered across selection and maybe vertical alignment to centered, then you could move cells onto this range using the usual drag and drop, which means dragging the cell's border.

The following set of event handlers and supporting macros assumes the range from which you would drag cells has the worksheet-level name bar and the range onto which you'd drop them has the worksheet-level name foo. It appends the values of cells dragged from bar and dropped onto foo to the value already in the first cell of foo.

'-- begin VBA ------
Option Explicit

Private src As Range


Private Sub Worksheet_Change(ByVal Target As Range)
  Const SEP As String = " "

  Dim v As Variant, x As Variant, dest As Range

  Set dest = Me.Names("foo").RefersToRange

  If Intersect(Target, dest) Is Nothing Then Exit Sub

  'the following statement allows you to clear foo
  'comment out or delete if you don't want to allow
  'clearing foo directly, but you'll need to provide
  'an indirect means for doing so - see reset macro below
  If Application.WorksheetFunction.CountA(dest) = 0 Then Exit Sub

  On Error GoTo CleanUp
  Application.EnableEvents = False

  v = Target.Value
  If Not IsArray(v) Then v = Array(v)  'ensure v is an array
  Application.Undo  'always undo

  If src Is Nothing Then
    MsgBox Title:="Error", Buttons:=vbOKOnly, _
     Prompt:="You may only move cells from " & _
     Me.Names("bar").RefersToRange.Address(0, 0) & " into " & _
     dest.Address(0, 0) & "."
  Else
    For Each x In v
      If IsEmpty(dest.Cells(1, 1).Value) Then
        dest.Cells(1, 1).Formula = "'" & x
      Else
        dest.Cells(1, 1).Formula = "'" & dest.Cells(1).Value & _
         SEP & x
      End If
    Next x
  End If

CleanUp:
  Application.EnableEvents = True
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Set src = Intersect(Target, Me.Names("bar").RefersToRange)
End Sub


Private Sub reset()
  Application.EnableEvents = False
  Me.Names("foo").RefersToRange.ClearContents
  Application.EnableEvents = True
End Sub
'-- end VBA ------

I think that the best way to get around this is to use the worksheet.SelectionChange event/method.

When the source cells gets activated/selected launch Activecell.copy

then, when clicking on the destination cell lauch a paste.special event.

Eric