Excel VBA - drag and drop cell to change order

I'm trying to create a manually 'drag and drop a cell to sort some rows of data'.
DragAndDrop.JPG
To do this, I need to capture into variable iFromRow the row dragged from (eg. iFromRow = 5 when 'Fred' is dragged to A7), and capture into variable iToRow the row dragged to (eg. iToRow = 7 in this example).

I played around with Worksheet_SelectionChange but got nowhere :(

Thanks for any ideas.

(I can do the actual 'sort' by programmatically Cut/Insert Row by using those two row numbers)
hindersalivaAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Martin LissOlder than dirtCommented:
Excel doesn't supply the events you need for a cell but I have an idea. To implement it I'd need to know if there's a limit to the range where it might be dragged, and if so can you tell me that range?
0
Martin LissOlder than dirtCommented:
My first idea was unworkable and the best I can do is this. It requires that the cell be double-clicked. In this code it only works in cells B5:B8 but that's easily changed.

Option Explicit
Private mRowDC As Range

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

If Not Intersect(Target, Range("B5:B8")) Is Nothing Then
    If vbYes = MsgBox("If you choose 'Yes', row " & Target.Row & " will be moved to the row of the next cell you select.", vbYesNo) Then
        Set mRowDC = Target
    End If
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not mRowDC Is Nothing Then
    Rows(mRowDC.Row).Cut
    Rows(Target.Row).Insert Shift:=xlDown
    Set mRowDC = Nothing
End If
End Sub

Open in new window

0
Martin LissOlder than dirtCommented:
I was able to improve it. This version adds a new "Move row" context menu item  when you right click a cell and I extended the range to B5:F8.
context menu28711509a.xlsm
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Cloud Class® Course: Python 3 Fundamentals

This course will teach participants about installing and configuring Python, syntax, importing, statements, types, strings, booleans, files, lists, tuples, comprehensions, functions, and classes.

[ fanpages ]IT Services ConsultantCommented:
Hi hindersaliva,

"I played around with Worksheet_SelectionChange but got nowhere :("

I can think of way to implement what you asked for using the Worksheet_SelectionChange(...) event.

Are there any limitations on your source/destination data in columns [ B ] moving to [A], or any specific factors that we should be aware of?

For example, will you always be using these two columns?  Will your data always start at cell [B5], & will it run contiguously down column [ B ]?
0
hindersalivaAuthor Commented:
Hi All,
I got it to work by Drag and Drop.

    Dim iFromRow As Integer
    Dim iToRow As Integer
    Dim strSwitch1 As String
    Dim strSwitch2 As String

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Target.Column = 2 Then

        iFromRow = Target.Row
        iFromColumn = 2
        strSwitch1 = "Yes"

    End If

    If Target.Column = 1 Then

        iToRow = Target.Row
        iToColumn = 1
        strSwitch2 = "Yes"

    End If

    If strSwitch1 = "Yes" And strSwitch2 = "Yes" Then
        Call DragAndDropToChangeOrder(iFromRow, iToRow)
        strSwitch1 = ""
        strSwitch2 = ""
    End If

End Sub

Open in new window


Sub DragAndDropToChangeOrder(iFromRow As Integer, iToRow As Integer)

    If iFromRow <> iToRow Then
    
        Cells(iFromRow, 1).EntireRow.Cut
        Cells(iToRow, 1).EntireRow.Insert Shift:=xlDown
                
    End If

    If iFromRow < iToRow Then
        Cells(iToRow, 1).Cut Destination:=Cells(iToRow - 1, 2)
    Else
        Cells(iToRow + 1, 1).Cut Destination:=Cells(iToRow, 2)
    End If

End Sub

Open in new window

0
hindersalivaAuthor Commented:
Here's my example file.
DragDropRunningOrder.xlsm
0
hindersalivaAuthor Commented:
The help from both Experts were useful in solving my problem.
Thanks.
1
Martin LissOlder than dirtCommented:
I think you have some problems with your solution. First, like my solution, I don't see where it's drag and drop, and second, when I click on say "Fred" in B8 and then click in column "A", all that seems to happen is that B8 is cleared.

In any case you're welcome and I'm glad I was able to help.

In my profile you'll find links to some articles I've written that may interest you.
Marty - MVP 2009 to 2015, Experts-Exchange Top Expert Visual Basic Classic 2012 to 2014
0
hindersalivaAuthor Commented:
Ah. Place cursor on cell 'Fred'. Drag it to another row, but to Column 1 of that row. Release. The order should change now.

I'll see if I can post a video on here.
0
Martin LissOlder than dirtCommented:
Please repost the workbook because the one you posted doesn't do anything when I follow your instructions.
0
hindersalivaAuthor Commented:
Here's a 30 sec video of how it works.
https://www.youtube.com/watch?v=z2l-ezdd9sg
1
[ fanpages ]IT Services ConsultantCommented:
^ Well done :)
0
Martin LissOlder than dirtCommented:
OK, I see that your not actually dragging and dropping but instead clicking twice, but there's a problem in the code in the workbook you posted. In that workbook you have this

Sub DragAndDropToChangeOrder(iFromRow As Integer, iToRow As Integer)

    If iFromRow <> iToRow Then
    
        Cells(iFromRow, 1).EntireRow.Cut
        Cells(iToRow, 1).EntireRow.Insert Shift:=xlDown
                
    End If

    If iFromRow < iToRow Then
        Cells(iToRow, 1).Cut Destination:=Cells(iToRow - 1, 2)
    Else
        Cells(iToRow + 1, 1).Cut Destination:=Cells(iToRow, 2)
    End If

End Sub

Open in new window

and lines 10 to 14 are a problem. Either line 11 or 13 will always be executed and what line 11 does for example is to cut the value in column 1, which is blank, and paste it over the cell in column 2 so that cell is blanked out. You don't seem to need lines 10 to 14 at all.
0
hindersalivaAuthor Commented:
Martin, I'm dragging the cell from where it is to the cell in column 1. Ie. Hovering over the edge. I'll do another video to make clear.
0
hindersalivaAuthor Commented:
Video 2 - hopefully clearer
https://www.youtube.com/watch?v=1uKtICV7IDw
0
hindersalivaAuthor Commented:
Martin, I need lines 10 to 14 because the user would have 'dragged' the cell to a new location in Col 1. This code Cut/Pastes it back to where it should be after the 'switch'.
0
Martin LissOlder than dirtCommented:
OK I see what you are doing but make sure you play by the "rules" or otherwise if you do something like I did which was to click in cell B7 and then click in cell A8, cell B7 will be cleared.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.