Home |
Search |
Today's Posts |
#1
|
|||
|
|||
Can't sort items within ONE cell - help please
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.) |
#2
|
|||
|
|||
CJSnet wrote:
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 :'( 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 -- Regards, Jay Freedman Microsoft Word MVP FAQ: http://word.mvps.org |
#3
|
|||
|
|||
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.) "Jay Freedman" wrote in message ... CJSnet wrote: 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 :'( 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 -- Regards, Jay Freedman Microsoft Word MVP FAQ: http://word.mvps.org |
#4
|
|||
|
|||
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 -- Regards, Jay Freedman Microsoft Word MVP FAQ: http://word.mvps.org CJSnet wrote: 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? "Jay Freedman" wrote in message ... CJSnet wrote: 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 :'( 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 -- Regards, Jay Freedman Microsoft Word MVP FAQ: http://word.mvps.org |
#5
|
|||
|
|||
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.) "Jay Freedman" wrote in message ... 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 -- Regards, Jay Freedman Microsoft Word MVP FAQ: http://word.mvps.org CJSnet wrote: 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? "Jay Freedman" wrote in message ... CJSnet wrote: 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 :'( 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 -- Regards, Jay Freedman Microsoft Word MVP FAQ: http://word.mvps.org |
#6
|
|||
|
|||
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" wrote in message ... 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.) "Jay Freedman" wrote in message ... 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 -- Regards, Jay Freedman Microsoft Word MVP FAQ: http://word.mvps.org CJSnet wrote: 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? "Jay Freedman" wrote in message ... CJSnet wrote: 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 :'( 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 -- Regards, Jay Freedman Microsoft Word MVP FAQ: http://word.mvps.org |
#7
|
|||
|
|||
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 |
#8
|
|||
|
|||
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 |
#9
|
|||
|
|||
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 |
#10
|
|||
|
|||
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 |
#11
|
|||
|
|||
You're certainly welcome... that's what we're here for!
-- Regards, Jay Freedman Microsoft Word MVP FAQ: http://word.mvps.org CJSnet wrote: 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. "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 |
#12
|
|||
|
|||
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 -- Regards, Jay Freedman Microsoft Word MVP FAQ: http://word.mvps.org CJSnet wrote: 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. "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 |
Reply |
Thread Tools | |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Table Sort - Sort only 3 of 4 columns | Microsoft Word Help | |||
Can't sort table alphabetically | Microsoft Word Help | |||
word table cell resize or word table cell size change or word table change cell size | Tables | |||
copy cell to cell | Tables | |||
Shading does not fill entire cell | Tables |