Word Sorting
Time enough for a quick bandaid. I added another utility that will take
names in lists formatted like:
George Washington IX
Thomas Jefferson VII
James Madison IV
and covert them to:
George Washington, IX
Thomas Jefferson, VII
James Madison, IV
For sorting as:
Jefferson, Thomas, VII
Madison, James, IV
Washington, George, IX
Then the second macro will swap arrangement and remove the improper comma
separation:
Thomas Jefferson VII
James Madison IV
George Washington IX
Option Explicit
Dim oPar As Paragraph
Dim oRng As Word.Range
Dim oRngSelected As Range
Dim bEndofDoc As Boolean
Sub ArrangeAndSortNames()
Set oRngSelected = Selection.Range
If oRngSelected.Paragraphs.Count 2 Then
MsgBox "There is no valid selection to sort"
Exit Sub
End If
bEndofDoc = False
If oRngSelected.End = ActiveDocument.Range.End Then
bEndofDoc = True
oRngSelected.InsertAfter vbCr
oRngSelected.MoveEnd wdParagraph, -1
End If
SetRemoveFlags oRngSelected, True
NumericalSuffixes oRngSelected, True
For Each oPar In oRngSelected.Paragraphs
Set oRng = oPar.Range
If InStr(oPar.Range.Text, ",") 0 Then
oRng.End = oRng.Start + InStr(oPar.Range.Text, ",") - 1
oRng.InsertBefore Trim(oRng.Words(oRng.Words.Count)) & ", "
oRng.Words(oRng.Words.Count).Delete
Else
oRng.End = oRng.End - 1
oRng.InsertBefore Trim(oRng.Words(oRng.Words.Count)) & ", "
oRng.Words(oRng.Words.Count).Delete
End If
Next
oRngSelected.Sort ExcludeHeader:=False, FieldNumber:="Paragraphs", _
SortFieldType:=wdSortFieldAlphanumeric, SortOrder:=wdSortOrderAscending, _
FieldNumber2:="", SortFieldType2:=wdSortFieldAlphanumeric, SortOrder2:= _
wdSortOrderAscending, FieldNumber3:="", SortFieldType3:= _
wdSortFieldAlphanumeric, SortOrder3:=wdSortOrderAscending, Separator:= _
wdSortSeparateByTabs, SortColumn:=False, CaseSensitive:=False, LanguageID
_
:=wdEnglishUS
SetRemoveFlags oRngSelected, False
Selection.Collapse wdCollapseStart
If bEndofDoc Then ActiveDocument.Range.Paragraphs.Last.Range.Delete
End Sub
Sub ArrangeFirstThenLast()
Dim pStr As String
Set oRngSelected = Selection.Range
bEndofDoc = False
If oRngSelected.End = ActiveDocument.Range.End Then
bEndofDoc = True
oRngSelected.InsertAfter vbCr
oRngSelected.MoveEnd wdParagraph, -1
End If
SetRemoveFlags oRngSelected, True
For Each oPar In oRngSelected.Paragraphs
Set oRng = oPar.Range
With oRng
pStr = " " & .Words.First.Text
.Collapse wdCollapseStart
.End = .Words.First.End + 2
.Delete
End With
Set oRng = oPar.Range
If InStr(oPar.Range.Text, ",") 0 Then
oRng.End = oRng.Start + InStr(oPar.Range.Text, ",") - 1
oRng.InsertAfter pStr
Else
oRng.End = oRng.End - 1
oRng.InsertAfter pStr
End If
Next
SetRemoveFlags oRngSelected, False
NumericalSuffixes oRngSelected, False
Selection.Collapse wdCollapseStart
If bEndofDoc Then ActiveDocument.Range.Paragraphs.Last.Range.Delete
End Sub
Sub SetRemoveFlags(ByRef oRngSearch As Word.Range, bSet As Boolean)
Dim vOrigText As Variant
Dim vFlagText As Variant
Dim i As Long
vOrigText = Array("-", Asc(30))
vFlagText = Array("XxXx", "YyYy")
With oRngSearch.Find
For i = 0 To UBound(vOrigText)
Select Case bSet
Case True
.Text = vOrigText(i)
.Replacement.Text = vFlagText(i)
Case Else
.Text = vFlagText(i)
.Replacement.Text = vOrigText(i)
End Select
.Execute Replace:=wdReplaceAll
Next i
End With
End Sub
Sub NumericalSuffixes(ByRef oRngSearch As Word.Range, bSet As Boolean)
Dim vOrigText As Variant
Dim i As Long
vOrigText = Array("III", "IV", "V", "VI", "VII", "VII", "IX", "X", "XI",
"XII", "XII", "XIV", _
"XV")
With oRngSearch.Find
.MatchWholeWord = True
.MatchWildcards = True
For i = 0 To UBound(vOrigText)
Select Case bSet
Case True
.Text = "([!,]) (" & vOrigText(i) & ")"
.Replacement.Text = "\1, \2"
Case Else
.Text = ", " & vOrigText(i)
.Replacement.Text = " " & vOrigText(i)
End Select
.Execute Replace:=wdReplaceAll
Next i
End With
End Sub
Peter T. Daniels wrote:
I figured you'd come through with a solution ... in the last one, is
the comma essential? Because usually one would write
Joe A. Miller, Jr.
Joe A. Miller III
(and when I had a tour of the University of Virginia many years ago,
more than one of the name placards on the elite rooms -- the cottages
designed by Thomas Jefferson -- had a VII. By now there might be a
ninth generation of boys with the same name.)
On Jan 16, 2:55 pm, Greg Maxey wrote:
The process for sorting a list of names gets more and more complex as
the variety of name formats increase. Then there is the complication
of hyphnated last names and suffixes. Follows is a group of macros
that represents the closest I have been able to come sorting
correctly. Both requires any suffixes to be separtate with a comma.
The first will take a list of names like
A. A. Zebra
Zeke J. Applebee
Joe A. Miller, III
and rearrange and sort as:
Applebee, Zeke J.
Miller, Joe A., III
Zebra, A. A.
The second will take
Applebee, Zeke J.
Miller, Joe A., III
Zebra, A. A.
and rearrange as:
Zeke J. Applebee
Joe A. Miller, III
A. A. Zebra
The third is a utility for dealing the hypenated last names.
Option Explicit
Dim oPar As Paragraph
Dim oRng As Word.Range
Dim oRngSelected As Range
Dim bEndofDoc As Boolean
Sub SortAndArrangeNames()
Set oRngSelected = Selection.Range
If oRngSelected.Paragraphs.Count 2 Then
MsgBox "There is no valid selection to sort"
Exit Sub
End If
bEndofDoc = False
If oRngSelected.End = ActiveDocument.Range.End Then
bEndofDoc = True
oRngSelected.InsertAfter vbCr
oRngSelected.MoveEnd wdParagraph, -1
End If
SetRemoveFlags oRngSelected, True
For Each oPar In oRngSelected.Paragraphs
Set oRng = oPar.Range
If InStr(oPar.Range.Text, ",") 0 Then
oRng.End = oRng.Start + InStr(oPar.Range.Text, ",") - 1
oRng.InsertBefore Trim(oRng.Words(oRng.Words.Count)) & ", "
oRng.Words(oRng.Words.Count).Delete
Else
oRng.End = oRng.End - 1
oRng.InsertBefore Trim(oRng.Words(oRng.Words.Count)) & ", "
oRng.Words(oRng.Words.Count).Delete
End If
Next
oRngSelected.Sort ExcludeHeader:=False, FieldNumber:="Paragraphs", _
SortFieldType:=wdSortFieldAlphanumeric,
SortOrder:=wdSortOrderAscending, _
FieldNumber2:="", SortFieldType2:=wdSortFieldAlphanumeric,
SortOrder2:= _
wdSortOrderAscending, FieldNumber3:="", SortFieldType3:= _
wdSortFieldAlphanumeric, SortOrder3:=wdSortOrderAscending,
Separator:= _
wdSortSeparateByTabs, SortColumn:=False, CaseSensitive:=False,
LanguageID _
:=wdEnglishUS
SetRemoveFlags oRngSelected, False
Selection.Collapse wdCollapseStart
If bEndofDoc Then ActiveDocument.Range.Paragraphs.Last.Range.Delete
End Sub
Sub SwapLastAndFirst()
Dim pStr As String
Set oRngSelected = Selection.Range
bEndofDoc = False
If oRngSelected.End = ActiveDocument.Range.End Then
bEndofDoc = True
oRngSelected.InsertAfter vbCr
oRngSelected.MoveEnd wdParagraph, -1
End If
SetRemoveFlags oRngSelected, True
For Each oPar In oRngSelected.Paragraphs
Set oRng = oPar.Range
With oRng
pStr = " " & .Words.First.Text
.Collapse wdCollapseStart
.End = .Words.First.End + 2
.Delete
End With
Set oRng = oPar.Range
If InStr(oPar.Range.Text, ",") 0 Then
oRng.End = oRng.Start + InStr(oPar.Range.Text, ",") - 1
oRng.InsertAfter pStr
Else
oRng.End = oRng.End - 1
oRng.InsertAfter pStr
End If
Next
SetRemoveFlags oRngSelected, False
Selection.Collapse wdCollapseStart
If bEndofDoc Then ActiveDocument.Range.Paragraphs.Last.Range.Delete
End Sub
Sub SetRemoveFlags(ByRef oRngSearch As Word.Range, bSet As Boolean)
Dim vOrigText As Variant
Dim vFlagText As Variant
Dim i As Long
vOrigText = Array("-", Asc(30))
vFlagText = Array("XxXx", "YyYy")
With oRngSearch.Find
For i = 0 To UBound(vOrigText)
Select Case bSet
Case True
.Text = vOrigText(i)
.Replacement.Text = vFlagText(i)
Case Else
.Text = vFlagText(i)
.Replacement.Text = vOrigText(i)
End Select
.Execute Replace:=wdReplaceAll
Next i
End With
End Sub
On Jan 15, 6:56 am, "Peter T. Daniels" wrote:
Help is so helpful!
Presumably one can write a macro to change all but the last space in
an entry to nonbreaking space.
On Jan 14, 11:05 pm, "Suzanne S. Barnhill"
wrote:
Word 2003's Help topic "About sorting" contains this intriguing
paragraph:
"You can also sort by more than one word or field inside a single
table
column. For example, if a column contains both last and first
names, you can
sort by either last name or first name, just as you could if the
last and
first names were in a list instead of a table."
There's an illustration that shows "Last Name, First Name" in what
appears
to be a single table column. The "Troubleshoot sorting" entry
dances all
around this without spelling it out (it does mention the
nonbreaking
spaces); it describes sorting by more than one word in a given
column but
appears to say nothing about using any but the first word as the
primary
sort key until you get to the very end:
"If you've already typed the entries, you can control the sort
order by
using a combination of regular spaces and nonbreaking spaces. Type
a regular
space between fields you want to sort on, and press
CTRL+SHIFT+SPACEBAR to
insert a nonbreaking space between fields you don'twant to sort
on. For
example, type Dr.nonbreaking spaceJohn Smith or John
Smith,nonbreaking
spaceM.D. Then select the list or table, and click Sort on the
Table menu.
Click Options, and then click Other under Separate fields at. In
the text
box, type a space, and then click OK. In the Sort by list, click
Word 2 (or
the field you want to sort by), and then complete the sort as
usual."
So yes, this is documented, but you have to wade through a lot of
other
stuff to get to it (and you can find it only in an article that
addresses "things that go wrong when I'm sorting," not in one that
actually tells you
how to do it right in the first place--an odd approach to take
IMO).
--
Suzanne S. Barnhill
Microsoft MVP (Word)
Words into Type
Fairhope, Alabama USAhttp://word.mvps.org
"PeterT.Daniels" wrote in
...
Wow. As someone said yesterday, Is that documented anywhere?
On Jan 14, 5:10 pm, "Suzanne S. Barnhill"
wrote:
Actually, you don'thave to convert to a table to sort the second
list. In the Sort dialog, click on Options, choose Other, and
type a space in the box, then click OK. When you return to the
Sort dialog, you should have Word
1 and Word 2 as options under "Sort by." Choose Word 2. If some
of the names
have middle names or initials, you'll need to prepare the list by
substituting a nonbreaking space (Ctrl+Shift+Spacebar) for the
space in, say, "PeterT." or "Mary Ann."
--
Suzanne S. Barnhill
Microsoft MVP (Word)
Words into Type
Fairhope, Alabama USAhttp://word.mvps.org
"PeterT.Daniels" wrote in
...
If they're in the form
Roe, Richard
Doe, John
(each name its own paragraph) then all you do is select the whole
list and choose Table Sort (they don'thave to be in a table).
If they're in the form
Richard Roe
John Doe
then you need to Convert to Table where the second column
contains the name you want to alphabetize on (simple if every
name has just a first name and a last name!), sort on that
column, and Convert back to Text.
On Jan 14, 1:51 pm, u50st wrote:
I swear I used to be able to sort a list of first and last names
by the last
name, however I can'tfigure out how I did it. I am using Word
2003.---
|