double click to copy then double click to paste

[david763]

Hi all, I regularly deal with a list that i need to match up with another (two lists x 4 columns, side by side (one blank column between)). Unfortunately there are always slight differences in the two data sets, so i need to do the match by eye, hence vlookups or any other formulas won't work.
I presently manually select the data (always one row x four columns) in one list and cut/paste up or down into a blank space which is the closest match to the adjacent list.
The upshot is that I select four cells containing data (eg cells F24:I24) and paste to a blank line somewhere above or below (ie target will be column F:G).

I wrote a bit of code that actually does work - as long as you cut the data before you paste it - ie double click in an area with data (source), before you double click in the blank (target), otherwise it crashes.

My mind is just not working at the moment - I cannot see a way to trap the sequence of steps, plus the code is about as clunky as i could possibly write it... Can anyone help me with this?

-------------
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Target.Column <> 6 Then Exit Sub


If Target.Value <> "" Then
Range(ActiveCell, ActiveCell.Offset(0, 4)).Select
Selection.Cut
Exit Sub
End If


If Target.Value = "" Then
ActiveSheet.Paste
Application.CutCopyMode = False
Exit Sub
End If


End Sub
-------------

Much appreciated,

David

 

[Peter_SSs]

Test this in a copy of your workbook. Give details if it doesn't do what you want.
Double-click in col F of the row you want to Cut then double-click in Col F of the row you want to Paste

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  If Target.Column = 6 Then
    Cancel = True
    Select Case Application.CutCopyMode
      Case 0
        Target.Resize(, 4).Cut
      Case Else
        ActiveSheet.Paste
        Application.CutCopyMode = False
    End Select
  End If
End Sub

 

[Yongle]

Try this instead

Double click leftmost cell in copy range (only ONE cell not the whole range)
Click leftmost cell in paste range (only ONE cell not the whole range)
Click "OK"

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim copyThis As Range, pasteHere As Range
    Cancel = True
    Set copythis = Target.Resize(, 4)
    Set pastehere = Application.InputBox("Paste where?", , , , , , , Type:=8)
    copythis.Copy pastehere
End Sub

I have ignored "CUT" and column number constraint for this first stab

 

[david763]

Thanks Peter and Yongle, both solutions worked a treat. I can modify to suit my application.

Kind regards

David

 

[Peter_SSs]

You're welcome. Glad to help.