Macro to move last row of Table to the top of the Table in Excel 2013

[Habitr]

I want to move the first row of excel Table to the end of Table and another VBA to move the last row of Table to the top of Table.

 

[RickXL]

Hi and welcome to the MrExcel Message Board.

Assuming you mean Table as in ListObject then these macros should work:

' http://www.thespreadsheetguru.com/blog/2014/6/20/the-vba-guide-to-listobject-excel-tables

Sub MoveFirstToLast()

    Dim ActiveTable As ListObject
    Dim arr As Variant

    'Determine if ActiveCell is inside a Table
    On Error GoTo NoTableSelected
        Set ActiveTable = ActiveSheet.ListObjects(ActiveCell.ListObject.Name)
    On Error GoTo 0

    ' Move First Row to the End
    With ActiveTable
        ' Copy the first row
        arr = .ListRows(1).Range
        ' Add it to the end of the table
        .ListRows(.ListRows.Count).Range.Offset(1) = arr
        ' Delete the first row
        .ListRows(1).Delete
    End With
    
    Exit Sub

'Error Handling
NoTableSelected:
    MsgBox "There is no Table currently selected!", vbCritical
End Sub

' http://www.thespreadsheetguru.com/blog/2014/6/20/the-vba-guide-to-listobject-excel-tables

Sub MoveLastToFirst()

    Dim ActiveTable As ListObject
    Dim arr As Variant

    'Determine if ActiveCell is inside a Table
    On Error GoTo NoTableSelected
        Set ActiveTable = ActiveSheet.ListObjects(ActiveCell.ListObject.Name)
    On Error GoTo 0

    ' Move First Row to the End
    With ActiveTable
        ' Copy the last row
        arr = .ListRows(.ListRows.Count).Range
        ' Delete the last row
        .ListRows(.ListRows.Count).Range.Delete
        ' Add a new first row
        .ListRows.Add (1)
        ' Place the copy into the first row
        .ListRows(1).Range = arr
    End With
    
    Exit Sub

'Error Handling
NoTableSelected:
    MsgBox "There is no Table currently selected!", vbCritical
End Sub

The link to thespreadsheetguru is where I found some useful information about Tables/ListObjects.

The code needs to be placed in a standard Macro Module and the Table needs to have the ActiveCell somewhere inside it so that the macros know which Table to process.

 

[RickXL]

I have tried the above macros with many Tables on a worksheet. If the Tables have overlapping columns Excel does not like you deleting rows. So I came up with an improved version that does not delete any rows.

There is one main macro which needs to be given a parameter which specifies the direction of the move: FirstToLast (=1) or LastToFirst (=2)

' http://www.thespreadsheetguru.com/blog/2014/6/20/the-vba-guide-to-listobject-excel-tables

Sub SwapEnds(dir As Long)
    ' dir=1 for First to Last
    ' dir=2 for Last to First
    Dim ActiveTable As ListObject
    Dim arrIn As Variant
    Dim arrOut As Variant
    Dim iIn As Long
    Dim iOut As Long
    Dim j As Long

    'Determine if ActiveCell is inside a Table
    On Error GoTo NoTableSelected
        Set ActiveTable = ActiveSheet.ListObjects(ActiveCell.ListObject.Name)
    On Error GoTo 0

    ' Move First Row to the End
    With ActiveTable
        arrIn = .DataBodyRange
        ReDim arrOut(1 To UBound(arrIn, 1), 1 To UBound(arrIn, 2))
        For iIn = 1 To UBound(arrIn, 1)
            If dir = 1 Then iOut = ((UBound(arrIn, 1) + iIn - 2) Mod UBound(arrIn, 1)) + 1
            If dir = 2 Then iOut = (iIn Mod UBound(arrIn, 1)) + 1
            For j = 1 To UBound(arrIn, 2)
                arrOut(iOut, j) = arrIn(iIn, j)
            Next
        Next
       .DataBodyRange = arrOut
    End With
    
    Exit Sub

'Error Handling
NoTableSelected:
    MsgBox "There is no Table currently selected!", vbCritical
End Sub

If you want to run this using two ActiveX buttons on the worksheet then this is the code that will go into the appropriate worksheet macro:

Private Sub FirstToLast_Click()
    Call SwapEnds(1)
End Sub

Private Sub LastToFirst_Click()
    Call SwapEnds(2)
End Sub