Finding numbers 1 to 10 with wildcards

[jimmyfuego]

Hi Guys,
Im hoping one of you knowledgeable people could help me out with this problem. I work with long word docs and need to find single numbers between 1 and 10 and replace them with words (one, two, three etc.).
I dabble with basic macros but cannot work out the wildcard structure needed search for only these numbers and ignore all other numerical combinations in the doc. Currently Im using macros like the one below which will find every single instance of '1' which is very time consuming. For clarity, I would like the macro to find all numbers from Set A, but ignore all numbers in Set B.
I have tried but am a bit foxed. Hope someone can help J
Thanks, James.

Set A - numbers to find:
Platform 9 is the correct one at the station.
10 people were there.
Of these, 1 was selected.
The end result was an increase of 10.

Set B - numbers to ignore:
Code number 4.3.10.
The date is 2005.
Effective provision of 100mph EMU trains
objectives set out in Section 1.3 of the doc.

Sub FindNumber1()
Selection.Find.ClearFormatting
With Selection.Find
.Text = "1"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
End Sub

[macropod]

Try the following:
Sub Demo()
Application.ScreenUpdating = False
Dim i As Integer, Rng As Range
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "[!0-9]{2}[0-9]{1,2}[!0-9]{2}"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
Do While .Find.Found
i = i + 1
Set Rng = .Duplicate
With Rng
.Start = .Start + 2
.End = .End - 2
If .Words.First = .Sentences.First.Words.First Then
Select Case .Text
Case 1: .Text = "One"
Case 2: .Text = "Two"
Case 3: .Text = "Three"
Case 4: .Text = "Four"
Case 5: .Text = "Five"
Case 6: .Text = "Six"
Case 7: .Text = "Seven"
Case 8: .Text = "Eight"
Case 9: .Text = "Nine"
Case 10: .Text = "Ten"
End Select
Else
Select Case .Text
Case 1: .Text = "one"
Case 2: .Text = "two"
Case 3: .Text = "three"
Case 4: .Text = "four"
Case 5: .Text = "five"
Case 6: .Text = "six"
Case 7: .Text = "seven"
Case 8: .Text = "eight"
Case 9: .Text = "nine"
Case 10: .Text = "ten"
End Select
End If
End With
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
Application.ScreenUpdating = True
Application.ScreenRefresh
MsgBox i & " numbers found."
End Sub

[jimmyfuego]

Hi Paul,

Just wanted to say thanks for writing that code and sorry I haven't replied sooner but the project I have been part of has been manic until now.

Your code did exactly as I asked so thanks. However, it also changed many other instances where I needed to keep the number instead of changing to text so I had to revert to the original way I was doing it. To be honest you code was like a bomb going off in my doc as it changed so many things :-)

This was my error as the Set B list of numbers to ignore was not comprehensive enough. It should have included these sorts of examples also:

section 2
plan 3
figure 4
Fig 7
table 5
£9
8%

Anyway, I have been through all the docs now and am hoping I wont get asked to do a similar task for a few a months. I just wanted to thank you for responding so quickly.

James

[macropod]

Hi James,

That's what happens when the project isn't adequately specified.

The issues you've raised could be be handled with a minor code change:
Sub Demo()
Application.ScreenUpdating = False
Dim i As Integer, Rng As Range, StrExcl As String
'Exclusions list - don't alter numbers following these words
StrExcl = ",fig,figure,section,plan,table,"
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
'Find 1-2 digit numbers not preceded by 0-9 or $€£¥ and not
'followed by 0-9 or ¢%, within 2 characters in either case.
.Text = "[!$€£¥0-9]{2}[0-9]{1,2}[!0-9¢%]{2}"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
Do While .Find.Found
'Check against the exclusions list.
If InStr(1, StrExcl, "," & Trim(.Duplicate.Characters.First.Words.First) & ",", vbTextCompare) = 0 Then
i = i + 1
Set Rng = .Duplicate
With Rng
.Start = .Start + 2
.End = .End - 2
'If the number 1-10 starts a sentence, capitalize the replacement word.
'Ignore numbers greater than 10.
If .Words.First = .Sentences.First.Words.First Then
Select Case .Text
Case 1: .Text = "One"
Case 2: .Text = "Two"
Case 3: .Text = "Three"
Case 4: .Text = "Four"
Case 5: .Text = "Five"
Case 6: .Text = "Six"
Case 7: .Text = "Seven"
Case 8: .Text = "Eight"
Case 9: .Text = "Nine"
Case 10: .Text = "Ten"
End Select
Else
Select Case .Text
Case 1: .Text = "one"
Case 2: .Text = "two"
Case 3: .Text = "three"
Case 4: .Text = "four"
Case 5: .Text = "five"
Case 6: .Text = "six"
Case 7: .Text = "seven"
Case 8: .Text = "eight"
Case 9: .Text = "nine"
Case 10: .Text = "ten"
End Select
End If
End With
End If
'Reset the end and look for the next potential match.
.End = .End - 2
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
Application.ScreenUpdating = True
Application.ScreenRefresh
MsgBox i & " numbers found."
End Sub
If you have more prefacing words/expressions that should not have the numbers altered, simply add them to the 'StrExcl' list, ensuring there is a comma either side of each entry.

[jimmyfuego]

Hi Paul,

Great amendments. I have played about with a copy and added to both the exclusions list and also the 'preceeded' and 'followed' wildcard exclusion lists.

It works much better now but I will always use it with track changes switched on so I can spot new exclusions and add them.

I format docs created by a large team of writers so it is difficult to plan for all the combinations of numbers and letters that they can dream up. I can understand that poorly specified projects must cause you guys real frustration though.

I hope your code can help others who are looking for the same thing.

Thanks again :-)

James