Replace only first occurence

[hansiman]

I have a small search and replace sub rutine that gets parameters:
searchfor and replacewith. Is there a way to only replace the first
occurence of searchfor?

/morten

 

[Peter Hewett]

Hi

Try the following code, this does what you want:

Sub ReplaceFirstOccurrence(ByVal strToFind As String, _
ByVal strReplacement As String)

' Uncomment this code if you ALWAYS want to replace the first
' occurrence in the document, otherwise the first occurrence
' from the START of the selection will be replaced
'Selection.HomeKey Unit:=wdStory

' Find and replace the first occurrence
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = strToFind
.Replacement.Text = strReplacement
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False

.Execute Replace:=wdReplaceOne
End With
End Sub

HTH + Cheers - Peter

 

[hansiman]

Thanks Peter That will do the job.
I'm curious! Is there a way to count the times a text was replaced?

/morten

 

[Jonathan West]

Thanks Peter That will do the job.
I'm curious! Is there a way to count the times a text was replaced?

Hi Morten,

You can adapt the code in this article

Finding out how many times some text appears in a document
http://word.mvps.org/FAQs/MacrosVBA/NoTimesTextInDoc.htm

 

[Peter Hewett]

Hi Hansiman

Yes you can count the number of replacements, but the code is different. In
your case your only replacing the first occurrence. This version replaces
ALL occurrences regardless of where you are in the document:

Sub SearchAndReplaceCount(ByVal strSought As String, _
ByVal strReplacement As String)
Dim rngReplace As Word.Range
Dim lngCount As Long

Set rngReplace = Selection.Range
With rngReplace.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = strSought
.Replacement.Text = strReplacement
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False

Do While .Execute(Replace:=wdReplaceOne)
lngCount = lngCount + 1

rngReplace.Collapse wdCollapseEnd
Loop
MsgBox lngCount & " Replacements were made"
End With
End Sub

HTH + Cheers - Peter