Hierarchy Sorting Macro

J

jlp1782

I created a document that has a table, whose first column consists of
numbers in a format of a headings.

1 Cats
1.1 Persian
1.2 Siamese
....
2 Dogs
2.1 Bull Dog
....
2.20 Poodle
etc.


The problem is, when you do a sort on this, it wants to put it like:
2
2.1
2.11
....
2.2
2.1.1
etc.
The reason why, is because 2.1 = 2.10...

When I produce the document, there is no sort in Reporter Plus for
Hierarchy Sorting. And, there is no sort in Word for this either. So, I
am trying, with my limited knowledge of Word VB to create a Macro to do
this for me.

Any suggestions?
 
D

Doug Robbins - Word MVP

If you used properly numbered headings, you would not need to sort it.

Given what you have, use a couple of Wildcard Find and Replaces, the first
one with

([1-9]{1})

in the Find what control, and

0\1

in the Replace with control

and the second one with

0([0-9]{2,})

in the Find what control and

\1

in the replace with control

That will change the numbers to the following format

01 Cats
01.01 Persian
01.02 Siamese
....
02 Dogs
02.01 Bull Dog
....
02.20 Poodle

Which should allow you to sort them.

If you then want to get rid of the leading 0's do another Wildcard Find and
Replace with

0([1-9]{1})

in the Find what control, and

\1

in the Replace with control.


--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP
 
J

jlp1782

Doug,

Thank you for helping me! I have never used Wild Cards before.
However, I was not able to get the second one you were talking about to
work. Also, can you explain a little more on what the functions mean.
This way, I can try to get them all working. I was doing a basic
example, I really have up to six heading levels! I thank you again,
this will be a lot easier than what I was trying!

Jess
 
J

jlp1782

Well, the problem it is having, is when I run the first one you gave
me, it finds 5.14 and makes it 05.0104...then the next one you have me
can't find anything.

I read the site too, but I am unsure of how to figure it out.

Thank you for helping me
Jess
 
T

Tony Jollans

On the Sort dialog, click on Options...
Under "Separate fields at", select Other and enter a dot in the box
Click OK, then sort the table and you should get the order you want.

I'm sure you can record code if you want it.
 
J

jlp1782

I have tried that already. For some reason it still keeps them in a
strange order
 
J

jlp1782

OK,

Here is how I did it:

Without a macro, I did a search for .1> and replaced with .01 and did
this through 9 (.9> .09)
Then I did a sort by that column, text...I know I did not use to the
full potential of Wild Cards, but it works


Here is my Macro to replace:
Sub Macro1()
'
' Macro1 Macro
' Macro recorded 2/7/2006 by Jessica Patla
'
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ".1>"
.Replacement.Text = ".01"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ".2>"
.Replacement.Text = ".02"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ".3>"
.Replacement.Text = ".03"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ".4>"
.Replacement.Text = ".04"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ".5>"
.Replacement.Text = ".05"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ".6>"
.Replacement.Text = ".06"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ".7>"
.Replacement.Text = ".07"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ".8>"
.Replacement.Text = ".08"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ".9>"
.Replacement.Text = ".09"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll

End Sub
 
J

jlp1782

Here is the final Macro: It will sort all tables with headings...


Sub Macro1()
'
' Macro1 Macro
' Macro recorded 2/7/2006 by Jessica Patla
'
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ".1>"
.Replacement.Text = ".01"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ".2>"
.Replacement.Text = ".02"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ".3>"
.Replacement.Text = ".03"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ".4>"
.Replacement.Text = ".04"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ".5>"
.Replacement.Text = ".05"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ".6>"
.Replacement.Text = ".06"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ".7>"
.Replacement.Text = ".07"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ".8>"
.Replacement.Text = ".08"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ".9>"
.Replacement.Text = ".09"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll

Dim tbl As Word.Table

For Each tbl In Word.ActiveDocument.Tables
tbl.Select
Selection.Sort ExcludeHeader:=True, FieldNumber:="Column 1",
SortFieldType _
:=wdSortFieldAlphanumeric, SortOrder:=wdSortOrderAscending,
FieldNumber2 _
:="", SortFieldType2:=wdSortFieldAlphanumeric, SortOrder2:= _
wdSortOrderAscending, FieldNumber3:="", SortFieldType3:= _
wdSortFieldAlphanumeric, SortOrder3:=wdSortOrderAscending,
Separator:= _
wdSortSeparateByCommas, SortColumn:=False, CaseSensitive:=True,
_
LanguageID:=wdEnglishUS, SubFieldNumber:="Paragraphs",
SubFieldNumber2:= _
"Paragraphs", SubFieldNumber3:="Paragraphs"

Next tbl

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ".01>"
.Replacement.Text = ".1"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ".02>"
.Replacement.Text = ".2"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll



Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ".03>"
.Replacement.Text = ".3"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll



Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ".04>"
.Replacement.Text = ".4"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll



Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ".05>"
.Replacement.Text = ".5"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll



Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ".06>"
.Replacement.Text = ".6"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll



Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ".07>"
.Replacement.Text = ".7"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll



Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ".08>"
.Replacement.Text = ".8"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll



Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ".09>"
.Replacement.Text = ".9"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll


End Sub
 
D

Doug Robbins - Word MVP

For the first one, use

<([1-9]{1})

instead of

([1-9]{1})

replacing it with

0\1

Don't bother with the second one.

Starting with

2.14 Somedog
1 Cats
1.1 Persian
1.2 Siamese
2 Dogs
2.1 Bull Dog
2.20 Poodle

The above will give you

02.014 Somedog
01 Cats
01.01 Persian
01.02 Siamese
02 Dogs
02.01 Bull Dog
02.020 Poodle

Then when you sort it, you will get

01 Cats
01.01 Persian
01.02 Siamese
02 Dogs
02.01 Bull Dog
02.014 Somedog
02.020 Poodle

Then use the third Find > Replace that I gave you to delete the leading 0's

This should work for upto 99 breeds for each type of animal.

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP
 
T

Tony Jollans

I have just tried it with your posted text and it works for me. Can you give
me an example of what doesn't work?
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Numbered List 1
body text numbering in same sequence as its heading 0
CROSS REFERENCE 5
Access 2003 Sorting Text 2
rolling up data at various levels based on a numbering system 0
Does MS200 contain a feature called "Outline numbering'. 1
Problems with heading numbering 2
Table of Context Page Numbers are incorrect 5

Top