Find/Replace of Phrases: How to Avoid Nesting?

[TT]

I need to run a series of find and replace operations on phrases. The idea
is to standardize the wording of phrases but I am having trouble avoiding
"nesting". Consider the following phrases that might be found in my
document:

Research Data Sharing
Data Sharing

I want to replace instances of "Data Sharing" with "Research Data Sharing".
The desired result should be:
Research Data Sharing
Research Data Sharing

However, if I do a search and replace, searching for "Data Sharing" and
replacing with "Research Data Sharing" the text would become:
Research Research Data Sharing
Research Data Sharing

How can I avoid this "nesting"?

Thanks!

 

[Greg]

TT,

A better solution may come along, but this can be done use a series of
F&R routing

Find and highlight all instances of Research Data Sharing.

Find and Replace all instances of Data Sharing (that is not
highlighted) with Research Data Sharing

Find all highlighted instances of Research Data Sharing and Replace
with no highligth.

 

[Greg]

TT,

Not extensively tested, but try:

Sub FindNestedInPhrase()
Dim rngstory As Word.Range
Dim chkString As String
Set rngstory = ActiveDocument.Range
With rngstory.Find
.ClearFormatting
.Wrap = wdFindStop
.Replacement.ClearFormatting
.MatchWholeWord = True
.Wrap = wdFindStop
.Text = "Data Sharing"
While .Execute
chkString = rngstory.Words.First.Previous(Unit:=wdWord, Count:=1)
If chkString <> "Research " Then
rngstory.Text = "Research Data Sharing"
rngstory.Collapse Direction:=wdCollapseEnd
Else
rngstory.Collapse Direction:=wdCollapseEnd
End If
Wend
End With
End Sub

 

[TT]

Greg: Thanks!

I cleaned it up a bit and turned it into a general purpose routine. The
first parameter is the one that will be replaced and the second is the
replacement text. For example, FindNestedInPhrase("Bar","Foo Bar") changes
"Foo" to "Foo Bar".


Sub FindNestedInPhrase(ByVal FndString As String, ByVal RplcString As
String)
Dim rngstory As Word.Range
Dim chkString As String
Set rngstory = ActiveDocument.Range
Dim FirstWordofRplcString As String
Dim FirstSpacePos As Integer
FirstSpacePos = InStr(1, RplcString, " ")
If RplcString = "" Then Exit Sub
If FirstSpacePos > 1 Then
FirstWordofRplcString = Mid(RplcString, 1, FirstSpacePos)
End If
With rngstory.Find
.ClearFormatting
.Wrap = wdFindStop
.Replacement.ClearFormatting
.MatchWholeWord = True
.Wrap = wdFindStop
.Text = FndString
While .Execute
If rngstory.Start > 1 Then chkString =
rngstory.Words.First.Previous(Unit:=wdWord, Count:=1)
If chkString <> FirstWordofRplcString Then
rngstory.Text = RplcString
rngstory.Collapse Direction:=wdCollapseEnd
Else
rngstory.Collapse Direction:=wdCollapseEnd
End If
Wend
End With
End Sub

 

[TT]

The following is more general:

Public Function StringAinStringB(ByVal StringA As String, ByVal StringB As
String, RngA As Range) As Boolean
Dim RngB As Range
Dim RngACount As Integer
Dim LeftOverlapPoint As Integer
Set RngB = ActiveDocument.Range
StringA = UCase(StringA)
StringB = UCase(StringB)
RngB.Start = RngA.Start
RngB.End = RngA.End
RngACount = (RngA.Characters.Count)
LeftOverlapPoint = InStr(1, StringB, StringA)
If StringB = "" Then
StringAinStringB = False
Exit Function
ElseIf LeftOverlapPoint = 0 Then
StringAinStringB = False
Exit Function
ElseIf (LeftOverlapPoint = 1) And (Len(StringB) = RngACount) Then
StringAinStringB = False
Exit Function
ElseIf LeftOverlapPoint = 1 Then
RngB.End = RngA.Start + Len(StringB)
If UCase(RngB.Text) = StringB Then
StringAinStringB = True
End If
ElseIf LeftOverlapPoint > 0 Then
RngB.Start = RngA.Start - LeftOverlapPoint + 1
RngB.End = RngB.Start + Len(StringB)
If UCase(RngB.Text) = StringB Then
StringAinStringB = True
End If
End If
End Function

Sub FindNestedInPhrase(ByVal FndString As String, ByVal RplcString As
String)
Dim FndRng As Range
Dim RplcRng As Range
Set FndRng = ActiveDocument.Range
With FndRng.Find
.ClearFormatting
.Wrap = wdFindStop
.Replacement.ClearFormatting
.MatchWholeWord = True
.Wrap = wdFindStop
.Text = FndString
While .Execute
If StringAinStringB(FndString, RplcString, FndRng) = False Then
If RplcString = "" Then
FndRng.Text = FndString
Else
FndRng.Text = RplcString
End If
End If
FndRng.Collapse Direction:=wdCollapseEnd
Wend
End With
End Sub