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.