Solution for anyone interested
Sub CET_ShiftRow(direction As String)
'Declare variables
Dim Table As Table
Dim row As Long
Dim i As Long
Dim j As Long
'Error handling
On Error GoTo Errhandler
With ActiveWindow.Selection
'Check that a single table is selected
If .ShapeRange.Count > 1 Then
MsgBox ("Error: Please select a single reference table")
Exit Sub
ElseIf .ShapeRange(1).HasTable <> msoTrue Then
MsgBox ("Error: Please select a single reference table")
Exit Sub
Else
Set Table = .ShapeRange(1).Table
End If
End With
'Loop through each row
For i = 1 To Table.Rows.Count
'Check if row has already been found
If row > 0 Then
'Exit loop as no need to complete it
Exit For
Else
'Check each cell in the row
For j = 1 To Table.Columns.Count
'Check if the cell is selected
If Table.Cell(i, j).Selected Then
row = i
Exit For
End If
Next j
End If
Next i
Select Case direction
Case Is = "MoveDown"
If row <> Table.Rows.Count Then
'Insert row above
Table.Rows.Add (row)
'Copy to row above
For j = 1 To Table.Columns.Count
Table.Cell(row, j).Shape.TextFrame.TextRange.Text = Table.Cell(row + 2, j).Shape.TextFrame.TextRange.Text
Next j
'Delete redundant row
Table.Rows(row + 2).Delete
'Retain selection of original row
Table.Cell(row + 1, 1).Select
End If
Case Is = "MoveUp"
If row <> 1 Then
'Insert row above
Table.Rows.Add (row - 1)
'Copy to row above
For j = 1 To Table.Columns.Count
Table.Cell(row - 1, j).Shape.TextFrame.TextRange.Text = Table.Cell(row + 1, j).Shape.TextFrame.TextRange.Text
Next j
'Delete redundant row
Table.Rows(row + 1).Delete
'Retain selection of original row
Table.Cell(row - 1, 1).Select
End If
End Select
Exit Sub
Errhandler:
MsgBox Error(Err)
Exit Sub
End Sub