Thank you SO much! The internet is a wonderful thing.

Hopefully this will also benefit similar Googlers with future similar
requests.

Thanks again. You made my day.
--
CJSnet

(Remove TEETH to reply by e-mail.)

"Jay Freedman" wrote in message
...
This turned out to be a lot more than 'fine-tuning' because there's no
way to know in advance what you've selected. It could be the whole
cell including the cell marker, the text of the whole cell but NOT
including the cell marker, some at the beginning, some in the middle,
or some at the end. Because of Word's quirkiness (some might call it
perverseness), each of these cases has to be handled differently.

Sub SortInOneCell()
Dim oRg As Range
Dim rgStart As Long, rgEnd As Long

If Not Selection.Information(wdWithInTable) Then
MsgBox "The cursor isn't in a table."
Exit Sub
End If

If Selection.Cells.Count 1 Then
MsgBox "Keep the selection within one cell."
Exit Sub
End If

With Selection
If .Range.Start .Cells(1).Range.Start Then
' add a para mark and exclude it
.InsertBefore vbCr
.MoveStart unit:=wdCharacter, Count:=1
End If
If (Right$(.Text, 2) ", ") And _
(.Range.End .Cells(1).Range.End - 1) Then
' if end of sel isn't at end of item or
' end of cell, extend it
.MoveEndUntil cset:=" "
.MoveEndWhile cset:=" "
Set oRg = .Range
Else
Set oRg = .Range
If (.Range.End = .Cells(1).Range.End) Then
' if sel includes cell marker, exclude it
oRg.MoveEnd unit:=wdCharacter, Count:=-1
End If
End If
End With

With oRg.Find
.Text = ", "
.Replacement.Text = "^p"
.Wrap = wdFindStop
.Execute Replace:=wdReplaceAll
End With

' the sort will collapse the range, so save it
rgStart = oRg.Start
rgEnd = oRg.End

' avoid error 'no items found to sort'
On Error Resume Next
oRg.Sort
On Error GoTo 0

' restore original range
Set oRg = ActiveDocument.Range(Start:=rgStart, End:=rgEnd)

' if any empty para, it sorts to the top
If oRg.Characters.First = vbCr Then
oRg.Characters.First.Delete
End If

With oRg.Find
.Text = "^p"
.Replacement.Text = ", "
.Wrap = wdFindStop
.Execute Replace:=wdReplaceAll
End With

With oRg
If (.Start .Cells(1).Range.Start) Then
' remove para mark inserted before sel
If .Characters.First.Previous = vbCr Then
.Characters.First.Previous.Delete
End If
End If
End With
End Sub


--
Regards,
Jay Freedman
Microsoft Word MVP FAQ: http://word.mvps.org

On Thu, 12 May 2005 20:56:25 +0100, "CJSnet"
wrote:

Wow, that's great. Sorry to be fussy though but I really do need it to
work
just on 'selected text' as I have some cells which have a few words at the
start that I don't want sorted.

Can you fine-tune once more?
--
Thanks.

CJSnet

(Remove TEETH to reply by e-mail.)

"Jay Freedman" wrote in message
news
On Mon, 9 May 2005 14:04:42 +0100, "CJSnet"
wrote:

I get an error 5992 that the document has mixed cell widths, which is
true.
However not for the cells I want to sort.

I think the best overall way to do this is for the Macro to only work on
'selected text'. Can that be done?

Ideally I'd just select each cell I want to sort (as there are actually
some
I don't), then run the macro.

Yes, we can do that... You don't even have to select the whole cell;
just put the cursor anywhere in the cell you want to sort, then run
this version of the macro.

Sub SortInOneCell()
Dim oRg As Range

If Not Selection.Information(wdWithInTable) Then
MsgBox "The cursor isn't in a table."
Exit Sub
End If

Set oRg = Selection.Cells(1).Range
oRg.MoveEnd unit:=wdCharacter, Count:=-1
With oRg.Find
.Text = ", "
.Replacement.Text = "^p"
.Wrap = wdFindStop
.Execute Replace:=wdReplaceAll
End With

oRg.Sort

Set oRg = Selection.Cells(1).Range
oRg.MoveEnd unit:=wdCharacter, Count:=-1
With oRg.Find
.Text = "^p"
.Replacement.Text = ", "
.Wrap = wdFindStop
.Execute Replace:=wdReplaceAll
End With
End Sub

--
Regards,
Jay Freedman
Microsoft Word MVP FAQ: http://word.mvps.org