Message Boxes do not work properly in search and replace macro.

[andreas]

Dear Experts:
I would like to insert a nonbreaking space between all occurrences of
the abbreviated Page (p.) and the page number. Below macro works fine!
BUT the my message boxes do not work correctly:

1. Although there are these "p." abbreviations in my test document,
the Message box says there are no occurrences of this abbreviation
found, and to make things worse, this message box pops up 7 times (the
number of range stories, I suppose).
2. BUT strangely the macro then correctly inserts the nonbreaking
spaces between the abbreviated page number (p.) and the page number!

Hence I need somebody to re-write this code so that the message boxes
appear correctly. Thank you very much in advance for your help.
Regards, Andreas


Sub InsertNonBreakingSpaceP()
'Inserting NonBreakingSpaces between the abbreviated page character
(p.) and the page number

Dim rngStory As Range
Dim iNumberOfReplacements As Integer

If MsgBox("Would you like to insert a nonbreaking space between p." &
vbCrLf & _
"and the page number?", vbYesNo, "Insertion of nonbreaking spaces") =
vbYes Then

For Each rngStory In ActiveDocument.StoryRanges

With rngStory.Find
.Text = "<p. {1;}([0-9])"
.MatchWildcards = True
.Wrap = wdFindContinue
.Execute

End With

If Not rngStory.Find.Found Then

MsgBox "There are no abbreviations (p.) in the document",
vbOKOnly, _
"Nothing found"
Else
rngStory.Find.Execute Replace:=wdReplaceAll,
replaceWith:="p.^s\1"

End If

Next rngStory

End If

End Sub

 

[Graham Mayor]

It works for me as written (except for the part -
"<p. {1;}([0-9])"
which uses a regional separator ';' rather than the ',' required for English
versions )
Are you sure that you have not run it twice, as it will produce a false
message if the changes have already been made. Check your document by
toggling the hidden formatting display by pressing CTRL+*

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


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

 

[Helmut Weber]

Hi Andreas,

in fact, I think, your macro works correctly.
There is only a difference between running it for the first time
and consecutive times, as a wildcard search distinguishes
between chr(32) and chr(160). In your search pattern there
is an ordinary space, which isn't there any longer after
the first execution.

An ordinary search for " " will find both chr(32) and chr(160).

Sub Test6009()
Dim bFound As Boolean
Dim rngStory As Range
For Each rngStory In ActiveDocument.StoryRanges
With rngStory.Find
.Text = "<p. {1,}([0-9])"
.MatchWildcards = True
.Execute
End With
If rngStory.Find.Found Then
bFound = True
rngStory.Find.Execute _
Replace:=wdReplaceAll, _
replaceWith:="p.^s\1"
End If
Next rngStory
If bFound = False Then
MsgBox "no (p.) in doc"
End If
End Sub

Still shorter:

Sub Test6009B()
Dim bFound As Boolean
Dim rngStory As Range
For Each rngStory In ActiveDocument.StoryRanges
With rngStory.Find
.Text = "<p. {1,}([0-9])"
.MatchWildcards = True
.Replacement.Text = "p.^s\1"
If .Execute(Replace:=wdReplaceAll) Then
bFound = True
End If
End With
Next rngStory
If Not bFound Then MsgBox "pattern not found"
End Sub

If you want to count the number of replacements,
some modification is required.

Furthermore, see:
http://word.mvps.org/faqs/customization/ReplaceAnywhere.htm

for linked story ranges.


--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

 

[Helmut Weber]

....beware of the list seperator,
I got a US-version here.

Helmut Weber

 

[andreas]

Graham,

thank you for the hint. You took me on the right track. Helmut Weber
even elaborated on it. Thank you to both of you. Regards, Andreas

It works for me as written (except for the part -
"<p. {1;}([0-9])"
which uses a regional separator ';' rather than the ',' required for English
versions )
Are you sure that you have not run it twice, as it will produce a false
message if the changes have already been made. Check your document by
toggling the hidden formatting display by pressing CTRL+*

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

My web sitewww.gmayor.com
Word MVP web sitehttp://word.mvps.org
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

Dear Experts:
I would like to insert a nonbreaking space between all occurrences of
the abbreviated Page (p.) and the page number. Below macro works fine!
BUT the my message boxes do not work correctly:

1. Although there are these "p." abbreviations in my test document,
the Message box says there are no occurrences of this abbreviation
found, and to make things worse, this message box pops up 7 times (the
number of range stories, I suppose).
2. BUT strangely the macro then correctly inserts the nonbreaking
spaces between the abbreviated page number (p.) and the page number!

Hence I need somebody to re-write this code so that the message boxes
appear correctly. Thank you very much in advance for your help.
Regards, Andreas

Sub InsertNonBreakingSpaceP()
'Inserting NonBreakingSpaces between the abbreviated page character
(p.) and the page number

Dim rngStory As Range
Dim iNumberOfReplacements As Integer

If MsgBox("Would you like to insert a nonbreaking space between p." &
vbCrLf & _
"and the page number?", vbYesNo, "Insertion of nonbreaking spaces") =
vbYes Then

For Each rngStory In ActiveDocument.StoryRanges

With rngStory.Find
.Text = "<p. {1;}([0-9])"
.MatchWildcards = True
.Wrap = wdFindContinue
.Execute

End With

If Not rngStory.Find.Found Then

MsgBox "There are no abbreviations (p.) in the document",
vbOKOnly, _
"Nothing found"
Else
rngStory.Find.Execute Replace:=wdReplaceAll,
replaceWith:="p.^s\1"

End If

Next rngStory

End If

End Sub- Zitierten Text ausblenden -

- Zitierten Text anzeigen -

 

[andreas]

...beware of the list seperator,
I got a US-version here.

Helmut Weber

Dear Helmut,

as always a superb reply. It is working. Great! As for the list
separator, I know that there is a difference between the german and
english office version ( I wonder why?)

You mentioned that if I wanted to display the number of replacements
made, that the code has to be modified. As a matter of fact, I was
thinking of this and tried, but to no avail.

Could you tell me how to do this?. But I assume this would be a major
coding job? Maybe this would even exceed the scope of this free
forum. Should this be the case let me know and we could make a paid
contract job out of it. Regards, Andreas

 

[Greg Maxey]

Andreas,

My "Find It" toolbar will perform this task and give you a count of
the replacements:

http://gregmaxey.mvps.org/Find_it_tool_bar.htm

 

[Greg Maxey]

You could do it like this. Note, while it likely doesnt' matter in your
particular application. You need the Do Statement and Set rngStory =
rngStory.NextStoryRange to process things like headers and footers,
textboxes, etc.


Sub Test()
Dim rngStory As Range
Dim i As Long
For Each rngStory In ActiveDocument.StoryRanges
Do
With rngStory.Find
.Text = "<p. {1,}([0-9])"
.MatchWildcards = True
.Replacement.Text = "p.^s\1"
While .Execute(Replace:=wdReplaceOne)
i = i + 1
rngStory.Collapse wdCollapseEnd
Wend
End With
Set rngStory = rngStory.NextStoryRange
Loop Until rngStory Is Nothing
Next rngStory
If i > 0 Then
MsgBox "Replacement made " & i & " times."
Else
MsgBox "pattern not found"
End If
End Sub

 

[Helmut Weber]

Hi Andreas,

as always a superb reply.

I admit, I am addicted to answers like that! ;-)

we could make a paid contract job out of it

Thank you so much,
but I need some 100000 Euros to secure my pension. ;-)



Sub Test6009BB()
Dim bFound As Boolean
Dim rngStory As Range
Dim lCount As Long
For Each rngStory In ActiveDocument.StoryRanges
With rngStory.Find
.Text = "<p. {1,}([0-9])"
.MatchWildcards = True
.Replacement.Text = "p.^s\1"
While .Execute(Replace:=wdReplaceOne)
rngStory.Select
bFound = True
lCount = lCount + 1
rngStory.End = Selection.StoryLength ' !!!
Wend
End With
Next rngStory
If Not bFound Then MsgBox "no (p.) in doc"
MsgBox "Replacements made " & lCount
End Sub

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

 

[Helmut Weber]

rngStory.Select

for testing only

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

 

[Greg Maxey]

Helmut,

It looks like I beat you to the draw by a second or two ;-)

Don't forget the .NextStroryRange when doing VBA find and replace in
Headers, Footers, and TextBoxes.


--
Greg Maxey/Word MVP
See:
http://gregmaxey.mvps.org/word_tips.htm
For some helpful tips using Word.

Hi Andreas,

as always a superb reply.

I admit, I am addicted to answers like that! ;-)

we could make a paid contract job out of it

Thank you so much,
but I need some 100000 Euros to secure my pension. ;-)



Sub Test6009BB()
Dim bFound As Boolean
Dim rngStory As Range
Dim lCount As Long
For Each rngStory In ActiveDocument.StoryRanges
With rngStory.Find
.Text = "<p. {1,}([0-9])"
.MatchWildcards = True
.Replacement.Text = "p.^s\1"
While .Execute(Replace:=wdReplaceOne)
rngStory.Select
bFound = True
lCount = lCount + 1
rngStory.End = Selection.StoryLength ' !!!
Wend
End With
Next rngStory
If Not bFound Then MsgBox "no (p.) in doc"
MsgBox "Replacements made " & lCount
End Sub

 

[Helmut Weber]

Hi Greg,

perfect.

Glad to see, we arrived at the almost same solution,
without the exception of the linked storyranges,
which I thought Andreas could manage, just in case,
from the material on the MVP pages.

While .Execute(Replace:=wdReplaceOne)
bFound = True
lCount = lCount + 1
rngStory.Collapse ' !!!
Wend

"Collapse" is far better than
setting the end of the selection.range anew.

I might have told you about that, if I recall correctly,
when we were once discussing searching in ranges.
Now it seems, I forgot about it, and in turn you showed me.
Heh, welcome!


Have a nice day.

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

 

[Greg Maxey]

Do
Learn
Teach
Loop

;-)

 

[Helmut Weber]

Hi Andreas,

we could make a paid contract job out of it.

if you feel like paying,
go to Greg's site and don't be afraid to find a military man.

http://gregmaxey.mvps.org/
http://gregmaxey.mvps.org/word_tips.htm

Greg will pass any donation on my behalf on to the charities
or just do the kids in the neighbourhood a favor.

Happened twice before in four years.

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

 

[Russ]

To All,
My text in previous text below:

Hi Greg,

perfect.

Glad to see, we arrived at the almost same solution,
without the exception of the linked storyranges,
which I thought Andreas could manage, just in case,
from the material on the MVP pages.

While .Execute(Replace:=wdReplaceOne)
bFound = True
lCount = lCount + 1
rngStory.Collapse ' !!!

rngStory.Collapse wdCollapseEnd
Since the .Collapse method defaults to wdCollapseStart, I think it is best
to get in the habit of using the collapse to end in a find loop, like Greg
did, to avoid re-finding the same text twice in a row (or infinite loop),
although in a wdReplaceOne-replace one loop, it might not matter.

 

[andreas]

Hi Andreas,


if you feel like paying,
go to Greg's site and don't be afraid to find a military man.

http://gregmaxey.mvps.org/http://gregmaxey.mvps.org/word_tips.htm

Greg will pass any donation on my behalf on to the charities
or just do the kids in the neighbourhood a favor.

Happened twice before in four years.

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

Dear Helmut and Greg,

thank you for your terrific help. Just came home from a nice outing
at the Lake Constance and I am seeing all this great support from you.
I will test all the answers tomorrow and let you know. Again, thank
you very much and of course I will make a donation on Greg's website.
Regards, Andreas

 

[Helmut Weber]

Hi Russ,

right you are.

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

 

[andreas]

Hi Russ,

right you are.

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

Greg and Helmut,

just tested the codes. They are working just fine. Very Good job.
Again, thank you very much for your superb support. Will now proceed
to do the donation.
Regards, Andreas