Drag and Drop

[sadsfan]

I want to be able to drag a name from a list and drop it into a cell, I don't want to use the inbuilt drag and drop as if I do this it copies across the original cell format and the copy and paste values is a bit beyond some others who have to use the worksheet.

Is there a way to do this in Excel? I have experimented with a list box but I am not sure if I can do this or what the code would be.

 

[MickG]

Perhaps you could use this ""Selection Change Event":-
Assuming your list is in column "A" then click that value then click the destination cell for the value to be copied over.

Private [COLOR="Navy"]Sub[/COLOR] Worksheet_SelectionChange(ByVal Target [COLOR="Navy"]As[/COLOR] Range)
Static oVal [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
    [COLOR="Navy"]If[/COLOR] Target.Column = 1 And oVal = "" [COLOR="Navy"]Then[/COLOR]
        oVal = Target
    [COLOR="Navy"]Else[/COLOR]
        Target = oVal
        oVal = ""
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[sadsfan]

Perhaps you could use this ""Selection Change Event":-
Assuming your list is in column "A" then click that value then click the destination cell for the value to be copied over.

Private [COLOR=navy]Sub[/COLOR] Worksheet_SelectionChange(ByVal Target [COLOR=navy]As[/COLOR] Range)
Static oVal [COLOR=navy]As[/COLOR] [COLOR=navy]String[/COLOR]
    [COLOR=navy]If[/COLOR] Target.Column = 1 And oVal = "" [COLOR=navy]Then[/COLOR]
        oVal = Target
    [COLOR=navy]Else[/COLOR]
        Target = oVal
        oVal = ""
    [COLOR=navy]End[/COLOR] If
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

Regards Mick

Thanks Mick, not quite drag and drop but it works a treat - thank you so much.

 

[sadsfan]

Mick, is there any way to copy across with formatting? e.g. font colour and whether Italic or Bold etc. Also, can you do this on multiple columns?

 

[MickG]

You're welcome.

 

[MickG]

Perhaps something like this:-

Private [COLOR="Navy"]Sub[/COLOR] Worksheet_SelectionChange(ByVal Target [COLOR="Navy"]As[/COLOR] Range)
  [COLOR="Navy"]If[/COLOR] Target.Count = 1 [COLOR="Navy"]Then[/COLOR]
    [COLOR="Navy"]If[/COLOR] Target.Column = 1 [COLOR="Navy"]Then[/COLOR]
      Application.CutCopyMode = False
        Target.Copy
    [COLOR="Navy"]ElseIf[/COLOR] Application.CutCopyMode = xlCopy [COLOR="Navy"]Then[/COLOR]
        Target.PasteSpecial Paste:=xlPasteAll
        Application.CutCopyMode = False
    [COLOR="Navy"]End[/COLOR] If
 [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[sadsfan]

Thanks Mick, I have had a play around with the code to see if I can get it to work on 2 columns rather than 1 but no joy. Do you know how to do this?

 

[sadsfan]

Mick, I think I've done it - this seems to work!

 Private Sub Worksheet_SelectionChange(ByVal Target As Range)  If Target.Count = 1 Then
    If Target.Column = 1 Then
      Application.CutCopyMode = False
        Target.Copy
    ElseIf Application.CutCopyMode = xlCopy Then
        Target.PasteSpecial Paste:=xlPasteAll
        Application.CutCopyMode = False
    End If
    End If
    
    If Target.Column = 2 Then
    If Target.Column = 2 Then
      Application.CutCopyMode = False
        Target.Copy
    ElseIf Application.CutCopyMode = xlCopy Then
        Target.PasteSpecial Paste:=xlPasteAll
        Application.CutCopyMode = False
    
    End If
    End If
    
  End Sub

 

[sadsfan]

Although it doesn't seem to work if there isn't a target column = 1, my target columns are b,c and d. Any ideas?

 

[MickG]

Try this:-

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Target.Count = 1 Then
    If Not Intersect(Target, Columns("B:D")) Is Nothing Then
      Application.CutCopyMode = False
        Target.Copy
    ElseIf Application.CutCopyMode = xlCopy Then
        Target.PasteSpecial Paste:=xlPasteAll
        Application.CutCopyMode = False
    End If
 End If
End Sub