[Helmut Weber]

Hi Suzanne,
hi Graham,

as there was no other amusement on a lazy sunday morning...

I wonder whether this will help the OP,
but is was a nice exercise:

Sub Test1()
Dim bEmp As Boolean ' is empty cell
Dim oTbl As Table
Dim oclm As Column
Dim oCll As Cell
Dim lngCll As Long
Dim cArr() As String
Set oTbl = Selection.Tables(1)
For Each oclm In oTbl.Columns
bEmp = False
oclm.Select
' is there an empty cell?
For Each oCll In Selection.Cells
If Len(oCll.Range.Text) = 2 Then
bEmp = True
Exit For
End If
Next
If bEmp = False Then
' no empty cell then just sort the column
Selection.Sort ExcludeHeader:=False, _
SortColumn:=True, _
sortorder:=wdSortOrderAscending
Else
' there is at least one empty cell
Selection.Sort ExcludeHeader:=False, _
SortColumn:=True, _
sortorder:=wdSortOrderAscending
lngCll = 0
' count not empty cells
For Each oCll In Selection.Cells
If Len(oCll.Range.Text) 2 Then
lngCll = lngCll + 1
End If
Next
' set up an array for the values of the not empty cells
ReDim cArr(1 To lngCll)
lngCll = 0
' put the sorted values into the array
For Each oCll In Selection.Cells
If Len(oCll.Range.Text) 2 Then
lngCll = lngCll + 1
cArr(lngCll) = _
Left(oCll.Range.Text, Len(oCll.Range.Text) - 2)
End If
Next
' unsort the column
ActiveDocument.Undo 1
lngCll = 0
' put the values from the array of not empty cells
' into the not empty cells
For Each oCll In Selection.Cells
If Len(oCll.Range.Text) 2 Then
lngCll = lngCll + 1
oCll.Range.Text = cArr(lngCll)
End If
Next
End If
Next
End Sub

I've used Word's sort algorithm in order to avoid
having to include something like bubblesort
and thus start a discussion about sorting, possibly.

Have a nice day.

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

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