Can't sort items within ONE cell - help please

C

CJSnet

Hi, I have a very long table with lots of cells. Each cell has many words
within it, separated by commas. E.g.:

one, two, three, four, five, six, seven...

I need to sort the words in each cell, alphabetically. Any idea on earth
how I can do this? Doesn't seem to wanna let me :'(
--
Thanks.

CJSnet

(Remove TEETH to reply by e-mail.)
 
J

Jay Freedman

CJSnet said:
Hi, I have a very long table with lots of cells. Each cell has many
words within it, separated by commas. E.g.:

one, two, three, four, five, six, seven...

I need to sort the words in each cell, alphabetically. Any idea on
earth how I can do this? Doesn't seem to wanna let me :'(
Click to expand...

Hi CJ,

The Sort command can sort paragraphs, but it can't sort within a single
paragraph. You have to split the list into separate paragraphs, sort, and
then put them back together.

Here's a macro that should do what you want. In each cell, it used
search&replace to change each comma-and-space into a paragraph mark, does
the sort on that cell, replaces the paragraph marks with comma-and-space,
and then moves on to the next cell. Before you start the macro, make sure
there aren't any paragraph marks in the table (use the ¶ button to display
nonprinting characters).

Sub SortInCells()
Dim oRg As Range
Dim oCell As Cell

Set oCell = ActiveDocument.Tables(1).Cell(1, 1)

Do
Set oRg = oCell.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 = oCell.Range
oRg.MoveEnd unit:=wdCharacter, Count:=-1
With oRg.Find
.Text = "^p"
.Replacement.Text = ", "
.Wrap = wdFindStop
.Execute Replace:=wdReplaceAll
End With

Set oCell = oCell.Next
Loop Until (oCell Is Nothing)
End Sub
 
C

CJSnet

Wow, that's great Jay thanks.

The only thing I should mention is that I have 3 columns and only want the
words in the 3rd column sorted. Is there a mod to the macro that instead of
moving onto the next cell will move down a cell?

Alternatively can I just run the macro and have it stop after it's sorted
the current cell, then I can run it again on the next relevant cell?
--
Thanks.

CJSnet

(Remove TEETH to reply by e-mail.)
 
J

Jay Freedman

Hi CJ,

Working only in column 3 is a minor variation (look at the For Each line):

Sub SortInCells()
Dim oRg As Range
Dim oCell As Cell

For Each oCell In ActiveDocument.Tables(1).Columns(3).Cells
Set oRg = oCell.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 = oCell.Range
oRg.MoveEnd unit:=wdCharacter, Count:=-1
With oRg.Find
.Text = "^p"
.Replacement.Text = ", "
.Wrap = wdFindStop
.Execute Replace:=wdReplaceAll
End With
Next oCell
End Sub
 
C

CJSnet

Hi Jay, how would I make this work, but just on the *current* cell but no
more?
--
Thanks.

CJSnet

(Remove TEETH to reply by e-mail.)
 
C

CJSnet

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.
--
Thanks.

CJSnet

(Remove TEETH to reply by e-mail.)

CJSnet said:
Hi Jay, how would I make this work, but just on the *current* cell but no
more?
--
Thanks.

CJSnet

(Remove TEETH to reply by e-mail.)
Click to expand...
 
J

Jay Freedman

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.
Click to expand...

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
 
C

CJSnet

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.)
 
J

Jay Freedman

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

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.)
Click to expand...
 
C

CJSnet

Thank you SO much! :D 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 said:
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
Click to expand...
 
J

Jay Freedman

Oops, one more fix...

If the original selection ends somewhere in the middle of the last word in
the cell, the macro will extend the selection to the next cell and then the
sort will fail to change anything. To fix this, change these lines
(actually, just the last of them):

' if end of sel isn't at end of item or
' end of cell, extend it
.MoveEndUntil cset:=" " & vbCr
 
Top