alphabetical paragraphs

[Guest]

I have an inventory of periodicals in alphabetical paragraphs. Within each
paragraph I would like to be able to sort alphabetically (Eg. A's - Aa, Ab,
Ac, Ad etc.) without highlighting and sorting each paragraph separately. Is
this possible?

 

[Greg]

Sinead,

I dabble with macros and I have cobbled together the following macro
which may meet your needs. Basically it takes your paragraph Ab, Az,
Aa, Ae and converts it to a table. The table is then sorted and
converted back to text. Unfortunately that conversion results in each
word in your original paragraph being converted to a single word
paragraph. The result

Aa
Ab
Ae
Az

ALl is not lost. A couple of Find and Replace strings can sort this
mess out. The only draw back I see, is if you have empty paragraphs
(which you shouldn't if you are a proper Word user ) then they will
be removed.

Sub ScratchMarco()
Dim oPara As Paragraph
Dim myRange As Range
Dim oTbl As Table
For Each oPara In ActiveDocument.Paragraphs
Set myRange = oPara.Range
myRange.MoveEnd Unit:=wdCharacter, Count:=-1
On Error Resume Next
myRange.ConvertToTable Separator:=wdSeparateByCommas, NumColumns:=1
Next
For Each oTbl In ActiveDocument.Tables
oTbl.Sort FieldNumber:="Column 1", _
SortFieldType:=wdSortFieldAlphanumeric,
SortOrder:=wdSortOrderAscending
oTbl.ConvertToText Separator:=","
Next
Set myRange = ActiveDocument.Range

myRange.Find.ClearFormatting
myRange.Find.Replacement.ClearFormatting
With myRange.Find
..Text = "([!^13])^13([!^13])"
..Replacement.Text = "\1, \2"
..Forward = True
..Wrap = wdFindContinue
..Format = False
..MatchCase = False
..MatchWholeWord = False
..MatchWildcards = True
..MatchSoundsLike = False
..MatchAllWordForms = False
End With
myRange.Find.Execute Replace:=wdReplaceAll
myRange.Find.ClearFormatting
myRange.Find.Replacement.ClearFormatting
With myRange.Find
..Text = "^13{2,}"
..Replacement.Text = "^13"
..Forward = True
..Wrap = wdFindContinue
..Format = False
..MatchCase = False
..MatchWholeWord = False
..MatchWildcards = True
..MatchSoundsLike = False
..MatchAllWordForms = False
End With
myRange.Find.Execute Replace:=wdReplaceAll

End Sub

 

[Guest]

Greg,
Thanks for your reply, I still have a small problem in that when I try to
run it it finds a 'compile error Expected: identifier or bracketed
expression' on all lines beginning '..' also 'compile error invalid
character' at the line 'oTbl.Sort FieldNumber....' and 'Expected expression'
on the two lines after. I have checked and double checked that the copy is
correct - is it me?

Thanks in advance

Sinéad

 

[Greg]

Naidee,

There shouldn't be any lines starting with ".." just "." (or one
period). As for the other error it is most likely do to the text
wrapping in the newsgroup window. In your VBA Editor go to
Tool>Options. Check all of the boxes on the editor tab. Click the
editor format tab and then the "Syntax error text" in the code color
window. Make it red or some other standout color.

Posted here that line is broken up into three segments. When I pasted
from here that separators were not working and I had to reformat it.

From the end of the first line bring the second line up then from the

end of the second line bring the third line up. Romove the _ and then
delete and readd the space between the comma and next charater. This
should clear up the error and the code will run.

Here is the code again. I just confirmed it works without error:

Sub ScratchMarco()
Dim oPara As Paragraph
Dim myRange As Range
Dim oTbl As Table
For Each oPara In ActiveDocument.Paragraphs
Set myRange = oPara.Range
myRange.MoveEnd Unit:=wdCharacter, Count:=-1
On Error Resume Next
myRange.ConvertToTable Separator:=wdSeparateByCommas, NumColumns:=1
Next
For Each oTbl In ActiveDocument.Tables
oTbl.Sort FieldNumber:="Column 1", _
SortFieldType:=wdSortFieldAlphanumeric, _
SortOrder:=wdSortOrderAscending
oTbl.ConvertToText Separator:=","
Next
Set myRange = ActiveDocument.Range


myRange.Find.ClearFormatting
myRange.Find.Replacement.ClearFormatting
With myRange.Find


..Text = "([!^13])^13([!^13])"
..Replacement.Text = "\1, \2"
..Forward = True
..Wrap = wdFindContinue
..Format = False
..MatchCase = False
..MatchWholeWord = False
..MatchWildcards = True
..MatchSoundsLike = False
..MatchAllWordForms = False
End With
myRange.Find.Execute Replace:=wdReplaceAll
myRange.Find.ClearFormatting
myRange.Find.Replacement.ClearFormatting
With myRange.Find
..Text = "^13{2,}"
..Replacement.Text = "^13"
..Forward = True
..Wrap = wdFindContinue
..Format = False
..MatchCase = False
..MatchWholeWord = False
..MatchWildcards = True
..MatchSoundsLike = False
..MatchAllWordForms = False
End With
myRange.Find.Execute Replace:=wdReplaceAll

End Sub

 

[Guest]

Greg
Thats works fine now,great.
Thank you for saving me hours of torure!

Naidee,

There shouldn't be any lines starting with ".." just "." (or one
period). As for the other error it is most likely do to the text
wrapping in the newsgroup window. In your VBA Editor go to
Tool>Options. Check all of the boxes on the editor tab. Click the
editor format tab and then the "Syntax error text" in the code color
window. Make it red or some other standout color.

Posted here that line is broken up into three segments. When I pasted
from here that separators were not working and I had to reformat it.

From the end of the first line bring the second line up then from the

end of the second line bring the third line up. Romove the _ and then
delete and readd the space between the comma and next charater. This
should clear up the error and the code will run.

Here is the code again. I just confirmed it works without error:

Sub ScratchMarco()
Dim oPara As Paragraph
Dim myRange As Range
Dim oTbl As Table
For Each oPara In ActiveDocument.Paragraphs
Set myRange = oPara.Range
myRange.MoveEnd Unit:=wdCharacter, Count:=-1
On Error Resume Next
myRange.ConvertToTable Separator:=wdSeparateByCommas, NumColumns:=1
Next
For Each oTbl In ActiveDocument.Tables
oTbl.Sort FieldNumber:="Column 1", _
SortFieldType:=wdSortFieldAlphanumeric, _
SortOrder:=wdSortOrderAscending
oTbl.ConvertToText Separator:=","
Next
Set myRange = ActiveDocument.Range


myRange.Find.ClearFormatting
myRange.Find.Replacement.ClearFormatting
With myRange.Find


..Text = "([!^13])^13([!^13])"
..Replacement.Text = "\1, \2"
..Forward = True
..Wrap = wdFindContinue
..Format = False
..MatchCase = False
..MatchWholeWord = False
..MatchWildcards = True
..MatchSoundsLike = False
..MatchAllWordForms = False
End With
myRange.Find.Execute Replace:=wdReplaceAll
myRange.Find.ClearFormatting
myRange.Find.Replacement.ClearFormatting
With myRange.Find
..Text = "^13{2,}"
..Replacement.Text = "^13"
..Forward = True
..Wrap = wdFindContinue
..Format = False
..MatchCase = False
..MatchWholeWord = False
..MatchWildcards = True
..MatchSoundsLike = False
..MatchAllWordForms = False
End With
myRange.Find.Execute Replace:=wdReplaceAll

End Sub