Moving table rows

[YossiD]

Is there a convenient way in Word VBA to move a table row to the top of the table?

[gmaxey]

Whatever works it usually convenient.


Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
With Selection.Tables(1)
.Rows.Add Selection.Tables(1).Rows(1)
.Rows(1).Range.FormattedText = Selection.Rows(1).Range.FormattedText
Selection.Rows(1).Delete
End With
lbl_Exit:
Exit Sub
End Sub

[mikewi]

Greg great macro. When I run this macro it resizes the first column. I added a bit to delete the blank row created (I believe you also wrote this). How do I keep the table from reformatting?


Sub MoveToTop()

Dim oTbl As Table, cel As Cell, lngIndex As Long, n As Long, fEmpty As Boolean

With Selection.Tables(1)
.Rows.Add Selection.Tables(1).Rows(1)
.Rows(1).Range.FormattedText = Selection.Rows(1).Range.FormattedText
Selection.Rows(1).Delete
End With
With ActiveDocument
For Each oTbl In .Tables
For lngIndex = oTbl.Rows.Count To 1 Step -1
If Len(oTbl.Rows(lngIndex).Range.Text) = (oTbl.Rows(lngIndex).Cells.Count * 2) + 2 Then _
oTbl.Rows(lngIndex).Delete
Next lngIndex
Next oTbl
End With
lbl_Exit:
Exit Sub
End Sub

[mikewi]

I guess that was a little more than needed. Still having the column formatting issue when "Selection.Rows(1).Delete" is executed.


Sub MoveRowToTop()

Dim oTbl As Table, cel As Cell, lngIndex As Long, n As Long, fEmpty As Boolean

With Selection.Tables(1)
.Rows.Add Selection.Tables(1).Rows(1)
.Rows(1).Range.FormattedText = Selection.Rows(1).Range.FormattedText
Selection.Rows(1).Delete
.Rows(2).Delete
End With

lbl_Exit:
Exit Sub
End Sub

[gmaxey]

Thanks. I'm not seeing that so you would have to attach a document illustrating the behavior.

[mikewi]

Sorry extra line removed


Sub MoveRowToTop()



With Selection.Tables(1)
.Rows.Add Selection.Tables(1).Rows(1)
.Rows(1).Range.FormattedText = Selection.Rows(1).Range.FormattedText
Selection.Rows(1).Delete
.Rows(2).Delete
End With

lbl_Exit:
Exit Sub
End Sub

[mikewi]

19373

here's the right attachment

FYI I'm using word 2016 and I'm running the macro from the document

[gmaxey]

Sub MoveRowToTop()
Dim oRng As Range
Dim oTbl As Table, cel As Cell, lngIndex As Long, n As Long, fEmpty As Boolean

With Selection.Tables(1)
.Rows.Add Selection.Tables(1).Rows(1)
.AutoFitBehavior wdAutoFitFixed
.Rows(1).Range.FormattedText = Selection.Rows(1).Range.FormattedText
Selection.Rows(1).Delete
.Rows(2).Delete
End With
lbl_Exit:
Exit Sub
End Sub

[mikewi]

Works perfect now.

[gmaxey]

I'm sure this isn't new, but I thought it would be interesting to expand this process to MoveToTop, MoveToBotton, MoveUp and MoveDown:


Option Explicit
Sub MoveToTop()
'A basic Word macro coded by Greg Maxey
If Selection.Range.Information(wdWithInTable) Then
With Selection.Tables(1)
.Rows.Add .Rows(1)
.Rows(1).Range.FormattedText = Selection.Rows(1).Range.FormattedText
Selection.Rows(1).Delete
.Rows(2).Delete
End With
End If
lbl_Exit:
Exit Sub
End Sub
Sub MoveToBottom()
'A basic Word macro coded by Greg Maxey
If Selection.Range.Information(wdWithInTable) Then
With Selection.Tables(1)
.Rows.Add
.Rows(.Rows.Count).Range.FormattedText = Selection.Rows(1).Range.FormattedText
Selection.Rows(1).Delete
.Rows(.Rows.Count).Delete
End With
End If
lbl_Exit:
Exit Sub
End Sub
Sub MoveUp()
'A basic Word macro coded by Greg Maxey
Dim oRow As Row
If Selection.Range.Information(wdWithInTable) Then
With Selection.Tables(1)
On Error GoTo Err_Top
Set oRow = .Rows.Add(Selection.Tables(1).Rows(Selection.Rows(1).Index - 1))
oRow.Range.FormattedText = Selection.Rows(1).Range.FormattedText
Selection.Rows(1).Delete
oRow.Previous.Range.Select
Selection.Collapse wdCollapseStart
oRow.Delete
End With
End If
lbl_Exit:
Exit Sub
Err_Top:
'Loop to bottom
MoveToBottom
Err.Clear
End Sub
Sub MoveDown()
'A basic Word macro coded by Greg Maxey
Dim oRow As Row
If Selection.Range.Information(wdWithInTable) Then
With Selection.Tables(1)
On Error GoTo Err_Top
If Selection.Rows(1).Index = .Rows.Count - 1 Then
Set oRow = .Rows.Add
Else
Set oRow = .Rows.Add(Selection.Tables(1).Rows(Selection.Rows(1).Index + 2))
End If
oRow.Range.FormattedText = Selection.Rows(1).Range.FormattedText
Selection.Rows(1).Delete
oRow.Previous.Range.Select
Selection.Collapse wdCollapseStart
oRow.Delete
End With
End If
lbl_Exit:
Exit Sub
Err_Top:
'Loop to top
MoveToTop
Err.Clear
End Sub

[YossiD]

Works a treat - thanks for all the helpful replies.

Considering that Word has a keyboard shortcut for moving rows up and down, it seems a bit strange that the way to do this in VBA is by creating a new row then copying and deleting.

You folks are terrific!

[gmaxey]

YossiD,

Learn something new everyday. Recall, I started off with "Whatever works ..."

Recording that shortcut unveiled (for me at least) the methed "Relocate". The code above can be adapted so multiple rows can be moved up, down, to top or to bottom.

Note that the code performs differently if a multiple rows are selected (only single selected rows are looped from bottom to top or top to bottom).



Sub MoveToTop()
'A basic Word macro coded by Greg Maxey
If Selection.Range.Information(wdWithInTable) Then
With Selection.Tables(1)
Do Until Selection.Rows(1).Index = 1
Selection.Range.Relocate wdRelocateUp
Loop
End With
End If
lbl_Exit:
Exit Sub
End Sub

Sub MoveToBottom()
'A basic Word macro coded by Greg Maxey
If Selection.Range.Information(wdWithInTable) Then
With Selection.Tables(1)
Do Until Selection.Rows.Last.Index = Selection.Tables(1).Rows.Count
Selection.Range.Relocate wdRelocateDown
Loop
End With
End If
lbl_Exit:
Exit Sub
End Sub
Sub MoveUp()
'A basic Word macro coded by Greg Maxey
If Selection.Range.Information(wdWithInTable) Then
On Error GoTo Err_Top
Selection.Range.Relocate wdRelocateUp
End If
lbl_Exit:
Exit Sub
Err_Top:
'Loop a single seleected row to bottom
If Selection.Rows.Count = 1 Then
MoveToBottom
End If
Err.Clear
End Sub
Sub MoveDown()
'A basic Word macro coded by Greg Maxey
If Selection.Range.Information(wdWithInTable) Then
If Not Selection.Rows.Last.Index = Selection.Tables(1).Rows.Count Then
Selection.Range.Relocate wdRelocateDown
Else
'Move a single selecteced row to top.
If Selection.Rows.Count = 1 Then
MoveToTop
End If
End If
End If
lbl_Exit:
Exit Sub
End Sub

[YossiD]

Bravo. Much more elegant.

I usually try recording when I don't know the appropriate function. Wonder why I didn't do that this time.