Cell Swapping Macro

[Tim Dexter]

Hi All

I have written a macro that will allow our users to swap
two
(multiple of two) adjacent cells in a table. It swaps the
contents
and the cell (column) widths. I have noticed however that
it does not
swap the font attributes e.g. bold. Without coding to swap
every
attribute that the text might have is there a simple way
to swap the
rich text rather than the raw text ?

Sub SwapTableCells()

Dim sCellText As String
' Turn on error checking.
On Error GoTo ErrorHandler
Title$ = "Swap Report Columns"

' Check cursor is onside table
If Selection.Information(wdWithInTable) Then

firstCol = Selection.Information
(wdStartOfRangeColumnNumber)
lastCol = Selection.Information(wdEndOfRangeColumnNumber)
firstRow = Selection.Information(wdStartOfRangeRowNumber)
lastRow = Selection.Information(wdEndOfRangeRowNumber)

' If user has selected more than 2 cols then error
If (lastCol - firstCol) = 1 Then
' Loop thru selected rows and cols
For sRow = firstRow To lastRow
For sCol = firstCol To lastCol
sCellText = Selection.Tables(1).Cell(sRow, sCol).Range
sCellText = Left$(sCellText, Len(sCellText) - 2)

If sCol = firstCol Then
copy1Val = sCellText
copy1Wid = Selection.Tables(1).Cell(sRow, sCol).Width
End If
copy2Val = sCellText
copy2Wid = Selection.Tables(1).Cell(sRow, sCol).Width
If sCol <> firstCol Then
' Copy contents and width to each cell
Selection.Tables(1).Cell(sRow, sCol - 1).Range = copy2Val
Selection.Tables(1).Cell(sRow, sCol - 1).Width = copy2Wid
Selection.Tables(1).Cell(sRow, sCol).Range = copy1Val
Selection.Tables(1).Cell(sRow, sCol).Width = copy1Wid
End If
Next sCol
Next sRow
Else
dummy = MsgBox("Please select two columns to swap",
vbOKOnly,
Title$)
End If

Else
dummy = MsgBox("Please select cells within a table to swap
them",
vbOKOnly, Title$)
End If

ErrorHandler:
If Err <> 0 Then
Dim Msg As String
Msg = "Error # " & Str(Err.Number) & Chr(13) &
Err.Description _
& Chr(13) & "Make sure there is a table in the current
document."
MsgBox Msg, , "Error"
End If

End Sub


Sorry, a couple of followups.
1. Is there a way to the Word undo manager that the cell
swap was just one action. Right now it takes 12 undo
actions to get the cells back to the way they were ?

2. Users may wish to swap two non adjacent cells contents.
Is there a way of detecting the selected cells ?

Thanks for any insight



Tim