Rearranging Table Columns

[Greg Maxey]

I have been playing around with some code to rearrange the columns of
a table.

E.g. existing data in a five column table

GRID NAME A B C D
1 2 3 4


Move column 5 before column 3. Then end result:

GRID NAME A D C B
1 4 3 2

I know (or think I know that you can't set a range = to a column so I
figured the best approach would be to write the data from the source
column (column 5) to an array. Add a new column before column 3.
Write the array results into the new column 3 and then delete the
source columne (now column 5).

Here is the basic code (stripped of error handling, etc.):

Sub ScrachMacroII()
Dim bProcess As Boolean
Dim myArray1() As String
Dim oCol1 As Long
Dim oCol2 As Long
Dim oTbl As Word.Table
Dim i As Long
Dim pStr1 As String
Dim newCol As Column
Dim lngLS As Long
bProcess = True
Do While bProcess
oCol1 = InputBox("Move column: ", "Source Column")
oCol2 = InputBox("Before column: ", "New Location")
On Error GoTo 0
For Each oTbl In ActiveDocument.Tables
If InStr(oTbl.Cell(1, 1).Range.Text, "GRID NAME") <> 0 Then
i = oTbl.Rows.Count
ReDim myArray1(i)
For i = 1 To oTbl.Rows.Count
pStr1 = oTbl.Cell(i, oCol1).Range.Text
myArray1(i - 1) = Left(pStr1, Len(pStr1) - 2)
Next i
Set newCol = oTbl.Columns.Add(BeforeColumn:=oTbl.Columns(oCol2))
lngLS = newCol.Next.Borders(wdBorderRight).LineStyle
newCol.Borders(wdBorderRight).LineStyle = lngLS
For i = 1 To oTbl.Rows.Count
oTbl.Cell(i, oCol2).Range.Text = myArray1(i - 1)
Next i
oTbl.Columns(oCol1 + 1).Delete
End If
Next oTbl
If MsgBox("Do you want to continue with another move?", _
vbQuestion + vbYesNo, "Continue?") = vbNo Then
bProcess = False
End If
Loop
Exit Sub
End Sub

I am just wondering if I have attempted to reinvent the wheel and if
there is a better, more simplified approach.

Thanks.

 

[Helmut Weber]

Hi Submariner,

in case I am wrong by assuming
that you want to avoid the selection, then:

Sub SwitchColumns(c1 As Long, c2 As Long)
With Selection.Tables(1)
.Columns(c2).Select
Selection.Cut
.Columns(c1).Select
Selection.Paste
End With
End Sub

Sub Test()
SwitchColumns 3, 4
End Sub

Cheers

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

 

[Greg Maxey]

Helmut,

In this case I don't have an aversion to select. It seems that I have
read that if you select a column then the actual range includes stuff
in other cells adjacent to it. You simple code proves different in
this case it seems.

Thanks.

 

[Helmut Weber]

Hi Greg,

In this case I don't have an aversion to select. It seems that I have
read that if you select a column then the actual range includes stuff
in other cells adjacent to it. You simple code proves different in
this case it seems.

A table is in a linear order, in priciple, from A1 to A2
to D3 to D4, for a 16 cells uniform table.

Yet it seems to me, that in the background,
when using the selection, pasting and copying it,
this drawback is taken care of without telling us.

You can put all of a uniform table in an array, like this:

Sub PutTableInArray()
Dim oTbl As Table
Dim sArr() As String
Set oTbl = ActiveDocument.Tables(1)
sArr = Split(oTbl.Range.Text, Chr(13) & Chr(7))
MsgBox sArr(3)
MsgBox sArr(4)

End Sub

From then on you can arrange the data in every thinkable way,
keeping in mind that every index which can be divided by 4
without reminder represents and end-of-row mark.

This is a nuisance, but not a problem.
One can play linear chess, as well.
No square required.

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

 

[Greg Maxey]

Thanks Helmut,

Sub PutTableInArray()
Dim oTbl As Table
Dim sArr() As String
Set oTbl = ActiveDocument.Tables(1)
sArr = Split(oTbl.Range.Text, Chr(13) & Chr(7))
Dim i As Long
For i = 0 To UBound(sArr)
If (i + 1) Mod 5 <> 0 Then
MsgBox sArr(i)
End If
Next
End Sub