Code won't execute Main Macro Calls - non breaking spaces

A

Ann Marie

Hi again Doug and Greg,


My MAIN MACRO does not execute the first 2 options DO FIND AND REPLACE. But
both syntax work in the Find and Replace window. The remainder of the MAIN
MACRO options execute.



Would appreciate if someone could point me in the right direction to fix
this. I would like to expand on my call routines but one step at a time.
Would really appreciate it.



TEST DATA:



20 June 2007

XXX 19 233 444 555

XXX 000 222 222

10 MAY 2006

13 JUNE 2006

13 may 2006

XXXX 123444

And this is a test sentence. This replace is just a test. Thank you for
helping? And that is that.



***MACROS***

Option Explicit



Sub DoFindReplace(FindText As String, ReplaceText As String, _

Optional bMatchWildCards As Boolean = False)



With Selection.Find

.ClearFormatting

.Replacement.ClearFormatting

.Text = FindText

.Replacement.Text = ReplaceText

.Forward = True

.Wrap = wdFindContinue

.Format = False

.MatchCase = False

.MatchWholeWord = False

.MatchWildcards = False

.MatchSoundsLike = False

.MatchAllWordForms = False



Do While .Execute

'Keep going until nothing found

.Execute Replace:=wdReplaceAll

Loop

'Free up some memory

ActiveDocument.UndoClear

End With



End Sub





'Call the macro:



Public Sub MainMacro()



'Replace spaces with non breaking spaces

Call DoFindReplace("([0-9]{1,2})([ADFJMNOS][A-Za-z]{2,})([0-9]{4})",
"\1^0160\2^0160\3^0160\4")



'Dates - replace spaces with non breaking spaces

Call
DoFindReplace(FindText:="([0-9]{1,2})(([0-9]{1,2})([ADFJMNOS][A-Za-z]{2,})([0-9]{4})",
ReplaceText:="\1^0160\2^0160\3", bMatchWildCards:=True)



'Remove double spaces TEST WORKS

Call DoFindReplace(" ", " ")



'Remove all double tabs TEST WORKS

Call DoFindReplace("^t^t", "^t")



'Remove empty paras (unless they follow a table or start or finish a
doc) TEST WORKS

Call DoFindReplace("^p^p", "^p")



End Sub
 
G

Graham Mayor

It would have been better if you had continued within the original thread.

The search patterns already quoted in that thread are suited only to the
formats you quoted there. Here you have three different number/letter
combinations. You will have to search for each pattern separately and search
the dates first or the months will cause problems. For your given list the
following will work. I have separated each find string and each replace
string for the sake of clarification. Start with the dates, then the longest
string, then work down to the shorter strings. Each is replaced by the
corresponding item in the replacement text array.

Sub ReplaceList()
Dim vFindText As Variant
Dim vReplText As Variant
Dim i As Long

vFindText = Array("([0-9]{1,2}) ([a-zA-Z]{3,}) ([0-9]{4})", _
"([A-Z]{3,4}) ([0-9]{2,}) ([0-9]{2,}) ([0-9]{2,}) ([0-9]{2,})", _
"([A-Z]{3,4}) ([0-9]{2,}) ([0-9]{2,}) ([0-9]{2,})", _
"([A-Z]{3,4}) ([0-9]{2,})")
vReplText = Array("\1^0160\2^0160\3", _
"\1^0160\2^0160\3^0160\4^0160\5", _
"\1^0160\2^0160\3^0160\4", _
"\1^0160\2")
With Selection.Find
.Forward = True
.Wrap = wdFindContinue
.MatchWholeWord = True
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
.Format = True
.MatchCase = True

For i = LBound(vFindText) To UBound(vFindText)
.Text = vFindText(i)
.Replacement.Text = vReplText(i)
.Execute replace:=wdReplaceAll
Next i
End With

End Sub


--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

Ann said:
Hi again Doug and Greg,


My MAIN MACRO does not execute the first 2 options DO FIND AND
REPLACE. But both syntax work in the Find and Replace window. The
remainder of the MAIN MACRO options execute.



Would appreciate if someone could point me in the right direction to
fix this. I would like to expand on my call routines but one step at
a time. Would really appreciate it.



TEST DATA:



20 June 2007

XXX 19 233 444 555

XXX 000 222 222

10 MAY 2006

13 JUNE 2006

13 may 2006

XXXX 123444

And this is a test sentence. This replace is just a test. Thank you
for helping? And that is that.



***MACROS***

Option Explicit



Sub DoFindReplace(FindText As String, ReplaceText As String, _

Optional bMatchWildCards As Boolean = False)



With Selection.Find

.ClearFormatting

.Replacement.ClearFormatting

.Text = FindText

.Replacement.Text = ReplaceText

.Forward = True

.Wrap = wdFindContinue

.Format = False

.MatchCase = False

.MatchWholeWord = False

.MatchWildcards = False

.MatchSoundsLike = False

.MatchAllWordForms = False



Do While .Execute

'Keep going until nothing found

.Execute Replace:=wdReplaceAll

Loop

'Free up some memory

ActiveDocument.UndoClear

End With



End Sub





'Call the macro:



Public Sub MainMacro()



'Replace spaces with non breaking spaces

Call
DoFindReplace("([0-9]{1,2})([ADFJMNOS][A-Za-z]{2,})([0-9]{4})",
"\1^0160\2^0160\3^0160\4")


'Dates - replace spaces with non breaking spaces

Call
DoFindReplace(FindText:="([0-9]{1,2})(([0-9]{1,2})([ADFJMNOS][A-Za-z]{2,})([0-9]{4})",
ReplaceText:="\1^0160\2^0160\3", bMatchWildCards:=True)



'Remove double spaces TEST WORKS

Call DoFindReplace(" ", " ")



'Remove all double tabs TEST WORKS

Call DoFindReplace("^t^t", "^t")



'Remove empty paras (unless they follow a table or start or finish
a doc) TEST WORKS

Call DoFindReplace("^p^p", "^p")



End Sub
Click to expand...
 
A

Ann Marie

Okay, will do that next time Graham.

This is looks great thank you for doing the code.

Graham Mayor said:
It would have been better if you had continued within the original thread.

The search patterns already quoted in that thread are suited only to the
formats you quoted there. Here you have three different number/letter
combinations. You will have to search for each pattern separately and
search the dates first or the months will cause problems. For your given
list the following will work. I have separated each find string and each
replace string for the sake of clarification. Start with the dates, then
the longest string, then work down to the shorter strings. Each is
replaced by the corresponding item in the replacement text array.

Sub ReplaceList()
Dim vFindText As Variant
Dim vReplText As Variant
Dim i As Long

vFindText = Array("([0-9]{1,2}) ([a-zA-Z]{3,}) ([0-9]{4})", _
"([A-Z]{3,4}) ([0-9]{2,}) ([0-9]{2,}) ([0-9]{2,}) ([0-9]{2,})", _
"([A-Z]{3,4}) ([0-9]{2,}) ([0-9]{2,}) ([0-9]{2,})", _
"([A-Z]{3,4}) ([0-9]{2,})")
vReplText = Array("\1^0160\2^0160\3", _
"\1^0160\2^0160\3^0160\4^0160\5", _
"\1^0160\2^0160\3^0160\4", _
"\1^0160\2")
With Selection.Find
.Forward = True
.Wrap = wdFindContinue
.MatchWholeWord = True
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
.Format = True
.MatchCase = True

For i = LBound(vFindText) To UBound(vFindText)
.Text = vFindText(i)
.Replacement.Text = vReplText(i)
.Execute replace:=wdReplaceAll
Next i
End With

End Sub


--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

Ann said:
Hi again Doug and Greg,


My MAIN MACRO does not execute the first 2 options DO FIND AND
REPLACE. But both syntax work in the Find and Replace window. The
remainder of the MAIN MACRO options execute.



Would appreciate if someone could point me in the right direction to
fix this. I would like to expand on my call routines but one step at
a time. Would really appreciate it.



TEST DATA:



20 June 2007

XXX 19 233 444 555

XXX 000 222 222

10 MAY 2006

13 JUNE 2006

13 may 2006

XXXX 123444

And this is a test sentence. This replace is just a test. Thank you
for helping? And that is that.



***MACROS***

Option Explicit



Sub DoFindReplace(FindText As String, ReplaceText As String, _

Optional bMatchWildCards As Boolean = False)



With Selection.Find

.ClearFormatting

.Replacement.ClearFormatting

.Text = FindText

.Replacement.Text = ReplaceText

.Forward = True

.Wrap = wdFindContinue

.Format = False

.MatchCase = False

.MatchWholeWord = False

.MatchWildcards = False

.MatchSoundsLike = False

.MatchAllWordForms = False



Do While .Execute

'Keep going until nothing found

.Execute Replace:=wdReplaceAll

Loop

'Free up some memory

ActiveDocument.UndoClear

End With



End Sub





'Call the macro:



Public Sub MainMacro()



'Replace spaces with non breaking spaces

Call
DoFindReplace("([0-9]{1,2})([ADFJMNOS][A-Za-z]{2,})([0-9]{4})",
"\1^0160\2^0160\3^0160\4")


'Dates - replace spaces with non breaking spaces

Call
DoFindReplace(FindText:="([0-9]{1,2})(([0-9]{1,2})([ADFJMNOS][A-Za-z]{2,})([0-9]{4})",
ReplaceText:="\1^0160\2^0160\3", bMatchWildCards:=True)



'Remove double spaces TEST WORKS

Call DoFindReplace(" ", " ")



'Remove all double tabs TEST WORKS

Call DoFindReplace("^t^t", "^t")



'Remove empty paras (unless they follow a table or start or finish
a doc) TEST WORKS

Call DoFindReplace("^p^p", "^p")



End Sub
Click to expand...
Click to expand...
 
A

Ann Marie

Perfect (as usual) Graham. Many thanks for your help.

Ann Marie said:
Okay, will do that next time Graham.

This is looks great thank you for doing the code.

Graham Mayor said:
It would have been better if you had continued within the original
thread.

The search patterns already quoted in that thread are suited only to the
formats you quoted there. Here you have three different number/letter
combinations. You will have to search for each pattern separately and
search the dates first or the months will cause problems. For your given
list the following will work. I have separated each find string and each
replace string for the sake of clarification. Start with the dates, then
the longest string, then work down to the shorter strings. Each is
replaced by the corresponding item in the replacement text array.

Sub ReplaceList()
Dim vFindText As Variant
Dim vReplText As Variant
Dim i As Long

vFindText = Array("([0-9]{1,2}) ([a-zA-Z]{3,}) ([0-9]{4})", _
"([A-Z]{3,4}) ([0-9]{2,}) ([0-9]{2,}) ([0-9]{2,}) ([0-9]{2,})", _
"([A-Z]{3,4}) ([0-9]{2,}) ([0-9]{2,}) ([0-9]{2,})", _
"([A-Z]{3,4}) ([0-9]{2,})")
vReplText = Array("\1^0160\2^0160\3", _
"\1^0160\2^0160\3^0160\4^0160\5", _
"\1^0160\2^0160\3^0160\4", _
"\1^0160\2")
With Selection.Find
.Forward = True
.Wrap = wdFindContinue
.MatchWholeWord = True
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
.Format = True
.MatchCase = True

For i = LBound(vFindText) To UBound(vFindText)
.Text = vFindText(i)
.Replacement.Text = vReplText(i)
.Execute replace:=wdReplaceAll
Next i
End With

End Sub


--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

Ann said:
Hi again Doug and Greg,


My MAIN MACRO does not execute the first 2 options DO FIND AND
REPLACE. But both syntax work in the Find and Replace window. The
remainder of the MAIN MACRO options execute.



Would appreciate if someone could point me in the right direction to
fix this. I would like to expand on my call routines but one step at
a time. Would really appreciate it.



TEST DATA:



20 June 2007

XXX 19 233 444 555

XXX 000 222 222

10 MAY 2006

13 JUNE 2006

13 may 2006

XXXX 123444

And this is a test sentence. This replace is just a test. Thank you
for helping? And that is that.



***MACROS***

Option Explicit



Sub DoFindReplace(FindText As String, ReplaceText As String, _

Optional bMatchWildCards As Boolean = False)



With Selection.Find

.ClearFormatting

.Replacement.ClearFormatting

.Text = FindText

.Replacement.Text = ReplaceText

.Forward = True

.Wrap = wdFindContinue

.Format = False

.MatchCase = False

.MatchWholeWord = False

.MatchWildcards = False

.MatchSoundsLike = False

.MatchAllWordForms = False



Do While .Execute

'Keep going until nothing found

.Execute Replace:=wdReplaceAll

Loop

'Free up some memory

ActiveDocument.UndoClear

End With



End Sub





'Call the macro:



Public Sub MainMacro()



'Replace spaces with non breaking spaces

Call
DoFindReplace("([0-9]{1,2})([ADFJMNOS][A-Za-z]{2,})([0-9]{4})",
"\1^0160\2^0160\3^0160\4")


'Dates - replace spaces with non breaking spaces

Call
DoFindReplace(FindText:="([0-9]{1,2})(([0-9]{1,2})([ADFJMNOS][A-Za-z]{2,})([0-9]{4})",
ReplaceText:="\1^0160\2^0160\3", bMatchWildCards:=True)



'Remove double spaces TEST WORKS

Call DoFindReplace(" ", " ")



'Remove all double tabs TEST WORKS

Call DoFindReplace("^t^t", "^t")



'Remove empty paras (unless they follow a table or start or finish
a doc) TEST WORKS

Call DoFindReplace("^p^p", "^p")



End Sub
Click to expand...
Click to expand...
Click to expand...
 
A

Ann Marie

Graham, a further question if you would be so kind to help me out.

I am going to attach my first array which is the same as you have written
except standard text.
Have your array to remedy any non breaking spaces in the standard text.
Then I would like to Call or Run a couple of other proofing macros at the
same time to complete the routine.

So each macro will execute one after the other.

So using the below macro how do I add call or run my remaing macros some of
which don't require MatchWildcards and do need clear and replace to be set.
One macro I need is the below macro:

Selection.Find.ClearFormatting

Selection.Find.Replacement.ClearFormatting



With Selection.Find

..Text = " {2,}"

..Replacement.Text = " "

..Wrap = wdFindStop

..MatchWildcards = True

..Execute Replace=wdReplaceAll

End With


Any ideas on how to do this would be great. Thank you so much.

Ann Marie said:
Okay, will do that next time Graham.

This is looks great thank you for doing the code.

Graham Mayor said:
It would have been better if you had continued within the original
thread.

The search patterns already quoted in that thread are suited only to the
formats you quoted there. Here you have three different number/letter
combinations. You will have to search for each pattern separately and
search the dates first or the months will cause problems. For your given
list the following will work. I have separated each find string and each
replace string for the sake of clarification. Start with the dates, then
the longest string, then work down to the shorter strings. Each is
replaced by the corresponding item in the replacement text array.

Sub ReplaceList()
Dim vFindText As Variant
Dim vReplText As Variant
Dim i As Long

vFindText = Array("([0-9]{1,2}) ([a-zA-Z]{3,}) ([0-9]{4})", _
"([A-Z]{3,4}) ([0-9]{2,}) ([0-9]{2,}) ([0-9]{2,}) ([0-9]{2,})", _
"([A-Z]{3,4}) ([0-9]{2,}) ([0-9]{2,}) ([0-9]{2,})", _
"([A-Z]{3,4}) ([0-9]{2,})")
vReplText = Array("\1^0160\2^0160\3", _
"\1^0160\2^0160\3^0160\4^0160\5", _
"\1^0160\2^0160\3^0160\4", _
"\1^0160\2")
With Selection.Find
.Forward = True
.Wrap = wdFindContinue
.MatchWholeWord = True
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
.Format = True
.MatchCase = True

For i = LBound(vFindText) To UBound(vFindText)
.Text = vFindText(i)
.Replacement.Text = vReplText(i)
.Execute replace:=wdReplaceAll
Next i
End With

End Sub


--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

Ann said:
Hi again Doug and Greg,


My MAIN MACRO does not execute the first 2 options DO FIND AND
REPLACE. But both syntax work in the Find and Replace window. The
remainder of the MAIN MACRO options execute.



Would appreciate if someone could point me in the right direction to
fix this. I would like to expand on my call routines but one step at
a time. Would really appreciate it.



TEST DATA:



20 June 2007

XXX 19 233 444 555

XXX 000 222 222

10 MAY 2006

13 JUNE 2006

13 may 2006

XXXX 123444

And this is a test sentence. This replace is just a test. Thank you
for helping? And that is that.



***MACROS***

Option Explicit



Sub DoFindReplace(FindText As String, ReplaceText As String, _

Optional bMatchWildCards As Boolean = False)



With Selection.Find

.ClearFormatting

.Replacement.ClearFormatting

.Text = FindText

.Replacement.Text = ReplaceText

.Forward = True

.Wrap = wdFindContinue

.Format = False

.MatchCase = False

.MatchWholeWord = False

.MatchWildcards = False

.MatchSoundsLike = False

.MatchAllWordForms = False



Do While .Execute

'Keep going until nothing found

.Execute Replace:=wdReplaceAll

Loop

'Free up some memory

ActiveDocument.UndoClear

End With



End Sub





'Call the macro:



Public Sub MainMacro()



'Replace spaces with non breaking spaces

Call
DoFindReplace("([0-9]{1,2})([ADFJMNOS][A-Za-z]{2,})([0-9]{4})",
"\1^0160\2^0160\3^0160\4")


'Dates - replace spaces with non breaking spaces

Call
DoFindReplace(FindText:="([0-9]{1,2})(([0-9]{1,2})([ADFJMNOS][A-Za-z]{2,})([0-9]{4})",
ReplaceText:="\1^0160\2^0160\3", bMatchWildCards:=True)



'Remove double spaces TEST WORKS

Call DoFindReplace(" ", " ")



'Remove all double tabs TEST WORKS

Call DoFindReplace("^t^t", "^t")



'Remove empty paras (unless they follow a table or start or finish
a doc) TEST WORKS

Call DoFindReplace("^p^p", "^p")



End Sub
Click to expand...
Click to expand...
Click to expand...
 
G

Graham Mayor

If I understand you correctly, you can add the extra searches at the start
of the array thus:

vFindText = Array(" {2,}", _
"([0-9]{1,2}) ([a-zA-Z]{3,}) ([0-9]{4})", _
"([A-Z]{3,4}) ([0-9]{2,}) ([0-9]{2,}) ([0-9]{2,}) ([0-9]{2,})", _
"([A-Z]{3,4}) ([0-9]{2,}) ([0-9]{2,}) ([0-9]{2,})", _
"([A-Z]{3,4}) ([0-9]{2,})")

vReplText = Array(" ", _
"\1^0160\2^0160\3", _
"\1^0160\2^0160\3^0160\4^0160\5", _
"\1^0160\2^0160\3^0160\4", _
"\1^0160\2")

What you want to search for should be in quotes and separated from the rest
of the list by a comma

Array("Word1", "Word2", "Word3")

or as I have it above

Array("Word1", _
"Word2", _
"Word3")

It is replaced with the corresponding item in the second list. Incidentally,
shouldn't that have been " {1,}" ? which will remove all extra standard
spaces

If this is a non breaking space rather than a standard space then search for
^0160. You will probably want to search for a non breaking space followed by
a space also? "^0160^032"
or vice versa.

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>


Ann said:
Graham, a further question if you would be so kind to help me out.

I am going to attach my first array which is the same as you have
written except standard text.
Have your array to remedy any non breaking spaces in the standard
text. Then I would like to Call or Run a couple of other proofing
macros at the same time to complete the routine.

So each macro will execute one after the other.

So using the below macro how do I add call or run my remaing macros
some of which don't require MatchWildcards and do need clear and
replace to be set. One macro I need is the below macro:

Selection.Find.ClearFormatting

Selection.Find.Replacement.ClearFormatting



With Selection.Find

.Text = " {2,}"

.Replacement.Text = " "

.Wrap = wdFindStop

.MatchWildcards = True

.Execute Replace=wdReplaceAll

End With


Any ideas on how to do this would be great. Thank you so much.

Ann Marie said:
Okay, will do that next time Graham.

This is looks great thank you for doing the code.

Graham Mayor said:
It would have been better if you had continued within the original
thread.

The search patterns already quoted in that thread are suited only
to the formats you quoted there. Here you have three different
number/letter combinations. You will have to search for each
pattern separately and search the dates first or the months will
cause problems. For your given list the following will work. I have
separated each find string and each replace string for the sake of
clarification. Start with the dates, then the longest string, then
work down to the shorter strings. Each is replaced by the
corresponding item in the replacement text array. Sub ReplaceList()
Dim vFindText As Variant
Dim vReplText As Variant
Dim i As Long

vFindText = Array("([0-9]{1,2}) ([a-zA-Z]{3,}) ([0-9]{4})", _
"([A-Z]{3,4}) ([0-9]{2,}) ([0-9]{2,}) ([0-9]{2,}) ([0-9]{2,})", _
"([A-Z]{3,4}) ([0-9]{2,}) ([0-9]{2,}) ([0-9]{2,})", _
"([A-Z]{3,4}) ([0-9]{2,})")
vReplText = Array("\1^0160\2^0160\3", _
"\1^0160\2^0160\3^0160\4^0160\5", _
"\1^0160\2^0160\3^0160\4", _
"\1^0160\2")
With Selection.Find
.Forward = True
.Wrap = wdFindContinue
.MatchWholeWord = True
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
.Format = True
.MatchCase = True

For i = LBound(vFindText) To UBound(vFindText)
.Text = vFindText(i)
.Replacement.Text = vReplText(i)
.Execute replace:=wdReplaceAll
Next i
End With

End Sub


--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com

<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

Ann Marie wrote:
Hi again Doug and Greg,


My MAIN MACRO does not execute the first 2 options DO FIND AND
REPLACE. But both syntax work in the Find and Replace window. The
remainder of the MAIN MACRO options execute.



Would appreciate if someone could point me in the right direction
to fix this. I would like to expand on my call routines but one
step at a time. Would really appreciate it.



TEST DATA:



20 June 2007

XXX 19 233 444 555

XXX 000 222 222

10 MAY 2006

13 JUNE 2006

13 may 2006

XXXX 123444

And this is a test sentence. This replace is just a test. Thank
you for helping? And that is that.



***MACROS***

Option Explicit



Sub DoFindReplace(FindText As String, ReplaceText As String, _

Optional bMatchWildCards As Boolean = False)



With Selection.Find

.ClearFormatting

.Replacement.ClearFormatting

.Text = FindText

.Replacement.Text = ReplaceText

.Forward = True

.Wrap = wdFindContinue

.Format = False

.MatchCase = False

.MatchWholeWord = False

.MatchWildcards = False

.MatchSoundsLike = False

.MatchAllWordForms = False



Do While .Execute

'Keep going until nothing found

.Execute Replace:=wdReplaceAll

Loop

'Free up some memory

ActiveDocument.UndoClear

End With



End Sub





'Call the macro:



Public Sub MainMacro()



'Replace spaces with non breaking spaces

Call
DoFindReplace("([0-9]{1,2})([ADFJMNOS][A-Za-z]{2,})([0-9]{4})",
"\1^0160\2^0160\3^0160\4")


'Dates - replace spaces with non breaking spaces

Call
DoFindReplace(FindText:="([0-9]{1,2})(([0-9]{1,2})([ADFJMNOS][A-Za-z]{2,})([0-9]{4})",
ReplaceText:="\1^0160\2^0160\3", bMatchWildCards:=True)



'Remove double spaces TEST WORKS

Call DoFindReplace(" ", " ")



'Remove all double tabs TEST WORKS

Call DoFindReplace("^t^t", "^t")



'Remove empty paras (unless they follow a table or start or
finish a doc) TEST WORKS

Call DoFindReplace("^p^p", "^p")



End Sub
Click to expand...
Click to expand...
Click to expand...
 
A

Ann Marie

I see - I shall put the arrays in and see how it executes.

No "2" works to make every space 1 space (which some require) and I have to
do another routine which does 2 spaces.

Appreciate all the guidance.

Graham Mayor said:
If I understand you correctly, you can add the extra searches at the start
of the array thus:

vFindText = Array(" {2,}", _
"([0-9]{1,2}) ([a-zA-Z]{3,}) ([0-9]{4})", _
"([A-Z]{3,4}) ([0-9]{2,}) ([0-9]{2,}) ([0-9]{2,}) ([0-9]{2,})", _
"([A-Z]{3,4}) ([0-9]{2,}) ([0-9]{2,}) ([0-9]{2,})", _
"([A-Z]{3,4}) ([0-9]{2,})")

vReplText = Array(" ", _
"\1^0160\2^0160\3", _
"\1^0160\2^0160\3^0160\4^0160\5", _
"\1^0160\2^0160\3^0160\4", _
"\1^0160\2")

What you want to search for should be in quotes and separated from the
rest of the list by a comma

Array("Word1", "Word2", "Word3")

or as I have it above

Array("Word1", _
"Word2", _
"Word3")

It is replaced with the corresponding item in the second list.
Incidentally, shouldn't that have been " {1,}" ? which will remove all
extra standard spaces

If this is a non breaking space rather than a standard space then search
for
^0160. You will probably want to search for a non breaking space followed
by a space also? "^0160^032"
or vice versa.

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>


Ann said:
Graham, a further question if you would be so kind to help me out.

I am going to attach my first array which is the same as you have
written except standard text.
Have your array to remedy any non breaking spaces in the standard
text. Then I would like to Call or Run a couple of other proofing
macros at the same time to complete the routine.

So each macro will execute one after the other.

So using the below macro how do I add call or run my remaing macros
some of which don't require MatchWildcards and do need clear and
replace to be set. One macro I need is the below macro:

Selection.Find.ClearFormatting

Selection.Find.Replacement.ClearFormatting



With Selection.Find

.Text = " {2,}"

.Replacement.Text = " "

.Wrap = wdFindStop

.MatchWildcards = True

.Execute Replace=wdReplaceAll

End With


Any ideas on how to do this would be great. Thank you so much.

Ann Marie said:
Okay, will do that next time Graham.

This is looks great thank you for doing the code.

It would have been better if you had continued within the original
thread.

The search patterns already quoted in that thread are suited only
to the formats you quoted there. Here you have three different
number/letter combinations. You will have to search for each
pattern separately and search the dates first or the months will
cause problems. For your given list the following will work. I have
separated each find string and each replace string for the sake of
clarification. Start with the dates, then the longest string, then
work down to the shorter strings. Each is replaced by the
corresponding item in the replacement text array. Sub ReplaceList()
Dim vFindText As Variant
Dim vReplText As Variant
Dim i As Long

vFindText = Array("([0-9]{1,2}) ([a-zA-Z]{3,}) ([0-9]{4})", _
"([A-Z]{3,4}) ([0-9]{2,}) ([0-9]{2,}) ([0-9]{2,}) ([0-9]{2,})", _
"([A-Z]{3,4}) ([0-9]{2,}) ([0-9]{2,}) ([0-9]{2,})", _
"([A-Z]{3,4}) ([0-9]{2,})")
vReplText = Array("\1^0160\2^0160\3", _
"\1^0160\2^0160\3^0160\4^0160\5", _
"\1^0160\2^0160\3^0160\4", _
"\1^0160\2")
With Selection.Find
.Forward = True
.Wrap = wdFindContinue
.MatchWholeWord = True
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
.Format = True
.MatchCase = True

For i = LBound(vFindText) To UBound(vFindText)
.Text = vFindText(i)
.Replacement.Text = vReplText(i)
.Execute replace:=wdReplaceAll
Next i
End With

End Sub


--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web site www.gmayor.com

<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

Ann Marie wrote:
Hi again Doug and Greg,


My MAIN MACRO does not execute the first 2 options DO FIND AND
REPLACE. But both syntax work in the Find and Replace window. The
remainder of the MAIN MACRO options execute.



Would appreciate if someone could point me in the right direction
to fix this. I would like to expand on my call routines but one
step at a time. Would really appreciate it.



TEST DATA:



20 June 2007

XXX 19 233 444 555

XXX 000 222 222

10 MAY 2006

13 JUNE 2006

13 may 2006

XXXX 123444

And this is a test sentence. This replace is just a test. Thank
you for helping? And that is that.



***MACROS***

Option Explicit



Sub DoFindReplace(FindText As String, ReplaceText As String, _

Optional bMatchWildCards As Boolean = False)



With Selection.Find

.ClearFormatting

.Replacement.ClearFormatting

.Text = FindText

.Replacement.Text = ReplaceText

.Forward = True

.Wrap = wdFindContinue

.Format = False

.MatchCase = False

.MatchWholeWord = False

.MatchWildcards = False

.MatchSoundsLike = False

.MatchAllWordForms = False



Do While .Execute

'Keep going until nothing found

.Execute Replace:=wdReplaceAll

Loop

'Free up some memory

ActiveDocument.UndoClear

End With



End Sub





'Call the macro:



Public Sub MainMacro()



'Replace spaces with non breaking spaces

Call
DoFindReplace("([0-9]{1,2})([ADFJMNOS][A-Za-z]{2,})([0-9]{4})",
"\1^0160\2^0160\3^0160\4")


'Dates - replace spaces with non breaking spaces

Call
DoFindReplace(FindText:="([0-9]{1,2})(([0-9]{1,2})([ADFJMNOS][A-Za-z]{2,})([0-9]{4})",
ReplaceText:="\1^0160\2^0160\3", bMatchWildCards:=True)



'Remove double spaces TEST WORKS

Call DoFindReplace(" ", " ")



'Remove all double tabs TEST WORKS

Call DoFindReplace("^t^t", "^t")



'Remove empty paras (unless they follow a table or start or
finish a doc) TEST WORKS

Call DoFindReplace("^p^p", "^p")



End Sub
Click to expand...
Click to expand...
Click to expand...
 
G

Greg Maxey

Ann,

Hi yourself. I don't recall being involved in this thread and perhaps
you have confusted me with Graham.

I couldn't sort out what your second search pattern was looking for,
but some reasons the first didn't work is that you didn't have regular
spaces in the search string and you didn't have wildcards set to
"True." Try this:

Public Sub MainMacro()
'Dates - replace spaces with non breaking spaces
DoFindReplace "([0-9]{1,}) ([ADFJMNOS][A-Za-z]{2,}) ([0-9]{4})",
"\1^0160\2^0160\3", True
'Remove double spaces TEST WORKS
DoFindReplace " ", " ", False
'Remove all double tabs TEST WORKS
DoFindReplace "^t^t", "^t", False
'Remove empty paras (unless they follow a table or start or finish a
doc) TEST WORKS
DoFindReplace "^p^p", "^p", False
End Sub

Sub DoFindReplace(FindText As String, ReplaceText As String,
bMatchWildCards As Boolean)
Dim oRng As Word.Range
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = FindText
.Replacement.Text = ReplaceText
.MatchWildcards = bMatchWildCards
.MatchAllWordForms = False
.Execute Replace:=wdReplaceAll
End With
'Free up some memory
ActiveDocument.UndoClear
End Sub
Ann said:
Hi again Doug and Greg,


My MAIN MACRO does not execute the first 2 options DO FIND AND REPLACE. But
both syntax work in the Find and Replace window. The remainder of the MAIN
MACRO options execute.



Would appreciate if someone could point me in the right direction to fix
this. I would like to expand on my call routines but one step at a time.
Would really appreciate it.



TEST DATA:



20 June 2007

XXX 19 233 444 555

XXX 000 222 222

10 MAY 2006

13 JUNE 2006

13 may 2006

XXXX 123444

And this is a test sentence. This replace is just a test. Thank you for
helping? And that is that.



***MACROS***

Option Explicit



Sub DoFindReplace(FindText As String, ReplaceText As String, _

Optional bMatchWildCards As Boolean = False)



With Selection.Find

.ClearFormatting

.Replacement.ClearFormatting

.Text = FindText

.Replacement.Text = ReplaceText

.Forward = True

.Wrap = wdFindContinue

.Format = False

.MatchCase = False

.MatchWholeWord = False

.MatchWildcards = False

.MatchSoundsLike = False

.MatchAllWordForms = False



Do While .Execute

'Keep going until nothing found

.Execute Replace:=wdReplaceAll

Loop

'Free up some memory

ActiveDocument.UndoClear

End With



End Sub





'Call the macro:



Public Sub MainMacro()



'Replace spaces with non breaking spaces

Call DoFindReplace("([0-9]{1,2})([ADFJMNOS][A-Za-z]{2,})([0-9]{4})",
"\1^0160\2^0160\3^0160\4")



'Dates - replace spaces with non breaking spaces

Call
DoFindReplace(FindText:="([0-9]{1,2})(([0-9]{1,2})([ADFJMNOS][A-Za-z]{2,})([0-9]{4})",
ReplaceText:="\1^0160\2^0160\3", bMatchWildCards:=True)



'Remove double spaces TEST WORKS

Call DoFindReplace(" ", " ")



'Remove all double tabs TEST WORKS

Call DoFindReplace("^t^t", "^t")



'Remove empty paras (unless they follow a table or start or finish a
doc) TEST WORKS

Call DoFindReplace("^p^p", "^p")



End Sub
Click to expand...
 
A

Ann Marie

Hi Greg,

Oops. I need ALL the help I can get - that's great. Thank you for that. My
project is almost complete because you were all so willing to share. THANK
YOU.

Greg Maxey said:
Ann,

Hi yourself. I don't recall being involved in this thread and perhaps
you have confusted me with Graham.

I couldn't sort out what your second search pattern was looking for,
but some reasons the first didn't work is that you didn't have regular
spaces in the search string and you didn't have wildcards set to
"True." Try this:

Public Sub MainMacro()
'Dates - replace spaces with non breaking spaces
DoFindReplace "([0-9]{1,}) ([ADFJMNOS][A-Za-z]{2,}) ([0-9]{4})",
"\1^0160\2^0160\3", True
'Remove double spaces TEST WORKS
DoFindReplace " ", " ", False
'Remove all double tabs TEST WORKS
DoFindReplace "^t^t", "^t", False
'Remove empty paras (unless they follow a table or start or finish a
doc) TEST WORKS
DoFindReplace "^p^p", "^p", False
End Sub

Sub DoFindReplace(FindText As String, ReplaceText As String,
bMatchWildCards As Boolean)
Dim oRng As Word.Range
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = FindText
.Replacement.Text = ReplaceText
.MatchWildcards = bMatchWildCards
.MatchAllWordForms = False
.Execute Replace:=wdReplaceAll
End With
'Free up some memory
ActiveDocument.UndoClear
End Sub
Ann said:
Hi again Doug and Greg,


My MAIN MACRO does not execute the first 2 options DO FIND AND REPLACE.
But
both syntax work in the Find and Replace window. The remainder of the
MAIN
MACRO options execute.



Would appreciate if someone could point me in the right direction to fix
this. I would like to expand on my call routines but one step at a time.
Would really appreciate it.



TEST DATA:



20 June 2007

XXX 19 233 444 555

XXX 000 222 222

10 MAY 2006

13 JUNE 2006

13 may 2006

XXXX 123444

And this is a test sentence. This replace is just a test. Thank you for
helping? And that is that.



***MACROS***

Option Explicit



Sub DoFindReplace(FindText As String, ReplaceText As String, _

Optional bMatchWildCards As Boolean = False)



With Selection.Find

.ClearFormatting

.Replacement.ClearFormatting

.Text = FindText

.Replacement.Text = ReplaceText

.Forward = True

.Wrap = wdFindContinue

.Format = False

.MatchCase = False

.MatchWholeWord = False

.MatchWildcards = False

.MatchSoundsLike = False

.MatchAllWordForms = False



Do While .Execute

'Keep going until nothing found

.Execute Replace:=wdReplaceAll

Loop

'Free up some memory

ActiveDocument.UndoClear

End With



End Sub





'Call the macro:



Public Sub MainMacro()



'Replace spaces with non breaking spaces

Call DoFindReplace("([0-9]{1,2})([ADFJMNOS][A-Za-z]{2,})([0-9]{4})",
"\1^0160\2^0160\3^0160\4")



'Dates - replace spaces with non breaking spaces

Call
DoFindReplace(FindText:="([0-9]{1,2})(([0-9]{1,2})([ADFJMNOS][A-Za-z]{2,})([0-9]{4})",
ReplaceText:="\1^0160\2^0160\3", bMatchWildCards:=True)



'Remove double spaces TEST WORKS

Call DoFindReplace(" ", " ")



'Remove all double tabs TEST WORKS

Call DoFindReplace("^t^t", "^t")



'Remove empty paras (unless they follow a table or start or finish a
doc) TEST WORKS

Call DoFindReplace("^p^p", "^p")



End Sub
Click to expand...
Click to expand...
 
R

Russ

Ann Marie,
See below.
Hi Greg,

Oops. I need ALL the help I can get - that's great. Thank you for that. My
project is almost complete because you were all so willing to share. THANK
YOU.

Greg Maxey said:
Ann,

Hi yourself. I don't recall being involved in this thread and perhaps
you have confusted me with Graham.

I couldn't sort out what your second search pattern was looking for,
but some reasons the first didn't work is that you didn't have regular
spaces in the search string and you didn't have wildcards set to
"True." Try this:

Public Sub MainMacro()
'Dates - replace spaces with non breaking spaces
DoFindReplace "([0-9]{1,}) ([ADFJMNOS][A-Za-z]{2,}) ([0-9]{4})",
"\1^0160\2^0160\3", True
'Remove double spaces TEST WORKS
DoFindReplace " ", " ", False
'Remove all double tabs TEST WORKS
DoFindReplace "^t^t", "^t", False
'Remove empty paras (unless they follow a table or start or finish a
doc) TEST WORKS
DoFindReplace "^p^p", "^p", False
End Sub

Sub DoFindReplace(FindText As String, ReplaceText As String,
bMatchWildCards As Boolean)
Dim oRng As Word.Range
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = FindText
.Replacement.Text = ReplaceText
.MatchWildcards = bMatchWildCards
.MatchAllWordForms = False
.Execute Replace:=wdReplaceAll
End With
'Free up some memory
ActiveDocument.UndoClear
End Sub
Ann said:
Hi again Doug and Greg,


My MAIN MACRO does not execute the first 2 options DO FIND AND REPLACE.
But
both syntax work in the Find and Replace window. The remainder of the
MAIN
MACRO options execute.



Would appreciate if someone could point me in the right direction to fix
this. I would like to expand on my call routines but one step at a time.
Would really appreciate it.



TEST DATA:



20 June 2007

XXX 19 233 444 555

XXX 000 222 222

10 MAY 2006

13 JUNE 2006

13 may 2006

XXXX 123444

And this is a test sentence. This replace is just a test. Thank you for
helping? And that is that.



***MACROS***

Option Explicit



Sub DoFindReplace(FindText As String, ReplaceText As String, _

Optional bMatchWildCards As Boolean = False)
Click to expand...
Click to expand...
Click to expand...

Look how the Sub is declared.
See Below.

Greg mentioned that you didn't have .MatchWildcards set to TRUE. One reason
could be that the line above should have been...
..MatchWildcards = bMatchWildCards
....To take advantage of the optional parameter or argument that was
available according to way the subroutine was declared above. So you had it
set up correctly but weren't using the information passed through it. It was
always set to FALSE.
.MatchSoundsLike = False

.MatchAllWordForms = False



Do While .Execute

'Keep going until nothing found

.Execute Replace:=wdReplaceAll

Loop

'Free up some memory

ActiveDocument.UndoClear

End With



End Sub





'Call the macro:



Public Sub MainMacro()



'Replace spaces with non breaking spaces

Call DoFindReplace("([0-9]{1,2})([ADFJMNOS][A-Za-z]{2,})([0-9]{4})",
"\1^0160\2^0160\3^0160\4")



'Dates - replace spaces with non breaking spaces

Call
DoFindReplace(FindText:="([0-9]{1,2})(([0-9]{1,2})([ADFJMNOS][A-Za-z]{2,})([
0-9]{4})",
ReplaceText:="\1^0160\2^0160\3", bMatchWildCards:=True)



'Remove double spaces TEST WORKS

Call DoFindReplace(" ", " ")



'Remove all double tabs TEST WORKS

Call DoFindReplace("^t^t", "^t")



'Remove empty paras (unless they follow a table or start or finish a
doc) TEST WORKS

Call DoFindReplace("^p^p", "^p")



End Sub
Click to expand...
Click to expand...
Click to expand...
 

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

Macro - add 2 spaces after the end of a sentence. 0
Find/Replace macro from excel into Word 0
Find/Replace macro from excel into Word 3
Convert MMDDYY to Text--Need with with my Macro 1
Need Macro help to Convert date to text 3
Do While Loop 1
Nesting Find and Replace Macros 2
Fixing double-spaces to single spaces in Word 2003 3

Top