Solved: Find, Replace, then modify Range Loop

[Adamski]

Hello,

I am writing a function to format some Captions.
The problem I am having is getting the find/replace code to loop corectly.
I have seen various ways to find all, find\replace all using 'wdReplaceAll', 'while .execute' and 'while .found' but what is the prefered method.
I can't do wdReplaceAll as I want to modify each range which is found after it is replaced.

Example Document Content:
123 Table 1-1: format and modify this para
8 Table 123-456: this one too
34 Table 2-12: and me
12 Figure 7-1: this as well

Required Styles:
Caption
Table Caption
Figure Caption

Simplified Function:
Sub ProcessCaptionType(oDocument As Document, sCaptionType As String)
Dim sBookmarkPrefix As String
sBookmarkPrefix = "s"
Dim oOldStyle As Style
Set oOldStyle = oDocument.Styles("Caption")
Dim oNewStyle As Style
Set oNewStyle = oDocument.Styles(sCaptionType & " Caption")

Dim oRange As Range
Set oRange = oDocument.Content.Duplicate

' Setup Find Object
With oRange.Find
.ClearFormatting
.Replacement.ClearFormatting
.Style = oOldStyle
.Text = "([0-9]{1,}) " & sCaptionType & " [0-9]{1,}-[0-9]{1,}: "
.Replacement.Text = "\1"
.Forward = True
.Wrap = wdFindStop
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
End With

' Find All
Do While oRange.Find.Execute(Replace:=wdReplaceOne)

' Get the ID for the Bookmark
Dim sID As String
sID = oRange.Text

' Change the Paragraph Style
oRange.Paragraphs.First.Range.Style = oNewStyle

' Modify the Range (Simplified)
oRange.Text = sCaptionType & sID & ": "

' Create Bookmark
oDocument.Bookmarks.Add Name:=sBookmarkPrefix & sID, Range:=oRange

Loop
End Sub

Sub test()
Call ProcessCaptionType(ActiveDocument, "Table")
Call ProcessCaptionType(ActiveDocument, "Figure")
End Sub

The modification to the range is more complex than this - adding fields etc.
The code works for the first match the the loop ends.
If I use this, it loops correctly:
Do While oRange.Find.Execute
(Note there is no replace parameter)

I can use that and get the sID as the first word, but then the code is specific to the find expression - If the find expression changes I'll need to modify the code too.

So...
How to loop find\replace while modifying each found range??

Thanks

[Adamski]

As usual, 5 minutes after posting I have to solved...
The oRange object needs to be restored (not replaced) to the original range. This keeps the oRange.Find object in tact.

Sub ProcessCaptionType(oFindRange As Range, sCaptionType As String)
Dim oDocument As Document
Set oDocument = oFindRange.Document
Dim sBookmarkPrefix As String
sBookmarkPrefix = "s"

Dim oOldStyle As Style
Set oOldStyle = oDocument.Styles("Caption")
Dim oNewStyle As Style
Set oNewStyle = oDocument.Styles(sCaptionType & " Caption")

Dim oRange As Range
Set oRange = oFindRange.Duplicate

' Setup Find Object
With oRange.Find
.ClearFormatting
.Replacement.ClearFormatting
.Style = oOldStyle
.Text = "([0-9]{1,}) " & sCaptionType & " [0-9]{1,}-[0-9]{1,}: "
.Replacement.Text = "\1"
.Forward = True
.Wrap = wdFindStop
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
End With

' Find All
Do While oRange.Find.Execute(Replace:=wdReplaceOne)

' Get the ID for the Bookmark
Dim sID As String
sID = oRange.Text

' Change the Paragraph Style
oRange.Paragraphs.First.Range.Style = oNewStyle

' Modify the Range (Simplified)
oRange.Text = sCaptionType & sID & ": "

' Create Bookmark
On Error Resume Next
oDocument.Bookmarks.Add Name:=sBookmarkPrefix & sID, Range:=oRange
On Error GoTo 0

' Restore the range
oRange.Start = oFindRange.Start
oRange.End = oFindRange.End
Loop
End Sub

Sub test()
Call ProcessCaptionType(Selection.Range, "Table")
Call ProcessCaptionType(Selection.Range, "Figure")
End Sub

[Frosty]

Glad to be of service!

Actually, just one thing you could do a bit differently, although the practical implications probably aren't that big of a deal...

At the bottom of your Do....Loop you restore your oRange to the entirety of the original oFindRange.

It would be better practice to collapse your found range, and start your next search just after your previously found range...

oRange.Collapse wdCollapseEnd
oRange.End = oFindRange.End

Why do this? Because Do....Loops are easier to make into infinite loops. And you could easily adjust your function at a later time, not realizing that you might adjust it in such a way that you occasionally find something and replace it with exactly the same thing-- and boom, this loop will now be infinite.

[Frosty]

And one other thought-- why are you using On Error Resume Next during the creation of your bookmark? To prevent attempting to generate a bookmark with the same name? If you're going to give up that easily, then you probably shouldn't create the bookmark at all, since you won't be able to rely on it being there.

A typical approach to this is to append the bookmark name with a random number... and then when searching for the bookmarks later, you can simply ignore the area of the bookmark that has the random number. A random number in the 10000 range can generally be enough, so you could change your bookmark naming convention to...
oDocument.Bookmarks.Add Name:=sBookmarkPrefix & sID & CStr(Int(100000 * rnd)), Range:=oRange

That would, in the majority of cases, prevent you from having an error there...

Of course-- you may need to adjust this methodology to have a special character ("_") or something as a prefix to the random number, so that you can more easily pick out your "real" data from your "I just need this to be unique" data.

[Adamski]

Thanks Frosty, both good points.

I was using on error resume next in case the bookmark name was invalid rather than not unique. Thinking about it though, it would be better to just allow this to raise an error as it shouldn't happen anyway.