Excel Table, move rows up

[wizmaster]

Hi All

I found this code on this forum. It will essentially use vba to move row of data to the line above. This moves the full row of data, how do I modify this so it only moves a row of data in a table to the line above? Also can this work irrespective of hidden Columns or auto filter selection ?


Sub ShiftUp()
With Selection.EntireRow
.Cut
.Offset(-1).Insert
.Select
End With
End Sub

 

[Alex Blakenburg]

Give this a try:

Sub CutCopyInsert()

    Dim lo As ListObject
    Dim selCell As Range
    Dim idxRow As Long, loRow As Long
    
    Set selCell = ActiveCell
    Set lo = selCell.ListObject
    
    loRow = lo.Range.Row
    idxRow = selCell.Row - loRow
    
    lo.ListRows(idxRow).Range.Cut
    lo.ListRows(idxRow - 1).Range.Insert Shift:=xlDown

End Sub

 

[wizmaster]

This is awseome and it works great! I was trying to do the same for moving the row down as well, however i couldn't get it to work. Could you help for that as well?

 

[Alex Blakenburg]

This is awseome and it works great! I was trying to do the same for moving the row down as well, however i couldn't get it to work. Could you help for that as well?

As long as it is not the 2nd last row in the table this should work.

    lo.ListRows(idxRow + 2).Range.Insert Shift:=xlDown

Actually if you reverse the logic on the insert above logic you get the below and it does work on the 2nd last row.

    lo.ListRows(idxRow + 1).Range.Cut
    lo.ListRows(idxRow).Range.Insert Shift:=xlDown

 

[wizmaster]

This is perfect! Thank you so much for your help!!!

 

[wizmaster]

One additional question. Please let me know if I should create another post for this. Can this code be modified to select multiple rows at once?

 

[Alex Blakenburg]

ok to move a selected number of rows up try this:

Sub CutCopyInsert_MultipleRows()

    Dim lo As ListObject
    Dim selRng As Range
    Dim idxRow As Long, loRow As Long, cntRow As Long
    
    Set selRng = Selection
    Set lo = selRng.ListObject
    
    cntRow = selRng.Rows.Count
    loRow = lo.Range.Row
    idxRow = selRng.Row - loRow
    
    ' Move rows up
    lo.ListRows(idxRow).Range.Resize(cntRow).Cut
    lo.ListRows(idxRow - 1).Range.Insert Shift:=xlDown

End Sub

To move the selected rows down, swap out the last 3 lines with this:

    ' Move selected rows down a row 
    lo.ListRows(idxRow + cntRow).Range.Cut
    lo.ListRows(idxRow).Range.Insert Shift:=xlDown

 

[wizmaster]

This works great! I am trying to modify it now to see if I can ask the user to prompt how many rows they want to move the selection up. So if they have a selection, and they enter 5 - it moves it up 5 rows. To do this I'm thinking this line i would need to somehow that input variable to IdxROw-variable. thoughts?

 

[wizmaster]

i for some reason can not get this to work.

Sub downward()


    Dim lo As ListObject
    Dim selRng As Range
    Dim idxRow As Long, loRow As Long, cntRow As Long
    
    Dim iInput As Integer
    
    iInput = InputBox("Please specify how many rows you would like to move it down", "How many rows?", 1)
        
    Set selRng = Selection
    Set lo = selRng.ListObject
    
    cntRow = selRng.Rows.Count
    loRow = lo.Range.Row
    idxRow = selRng.Row - loRow
    newrow = idxRow + iInput
    
    lo.ListRows(idxRow + cntRow).Range.Cut
    lo.ListRows(newrow).Range.Insert Shift:=xlDown
    lo.ListRows(newrow).Range.Resize(cntRow).Select
    
    
End Sub

this works for the upward movement;

Sub upwardsbynum()

    Dim lo As ListObject
    Dim selRng As Range
    Dim idxRow As Long, loRow As Long, cntRow As Long
    Dim iInput As Integer
    
    iInput = InputBox("Please specify how many rows you would like to move it up", "How many rows?", 1)
    
    Set selRng = Selection
    Set lo = selRng.ListObject
    
    cntRow = selRng.Rows.Count
    loRow = lo.Range.Row
    idxRow = selRng.Row - loRow
    
    ' Move rows up
    lo.ListRows(idxRow).Range.Resize(cntRow).Cut
    lo.ListRows(idxRow - iInput).Range.Insert Shift:=xlDown
    lo.ListRows(idxRow - iInput).Range.Resize(cntRow).Select
    
    

End Sub

 

[Alex Blakenburg]

Deleted - need to have another look