Word In the below script Can I have Riccarton as well as New Plymouth

Question

Hello from Steve

Word In the below script Can I have Riccarton as well as New Plymouth.

Sub LeftA()

Dim c As New Collection, p As Variant, r As range, f As Object

Set f = ActiveDocument.Content.Find

With f

  .ClearFormatting: .Text = "RICCARTON": .Wrap = wdFindStop

  Do While .Execute

      For p = GetPage(.Parent.Start) To GetPage(.Parent.End)

           On Error Resume Next: c.Add p, CStr(p): On Error GoTo 0

      Next

      .Parent.Collapse wdCollapseEnd

  Loop

End With

For Each p In c

  Set r = GetRange(CLng(p))

  If Not r Is Nothing Then FormatRanges r

Next

End Sub

Function GetPage(pos As Long) As Long

GetPage = ActiveDocument.range(pos, pos).Information(wdActiveEndPageNumber)

End Function

Function GetRange(pg As Long) As range

With ActiveDocument

  Set GetRange = .range(.GoTo(wdGoToPage, , pg).Start, .GoTo(wdGoToPage, , pg + 1).Start)

  If pg = .ComputeStatistics(wdStatisticPages) Then GetRange.End = .Content.End

End With

End Function

Sub FormatRanges(rng As range)

Dim oRng As range

Set oRng = rng.Duplicate

With rng.Find

  .ClearFormatting: .Text = "L\([0-9]{1,}-[0-9]{1,}-[0-9]{1,}\)": .MatchWildcards = True: .Wrap = wdFindStop

  While .Execute And .Parent.End <= oRng.End

      With ActiveDocument.range(.Parent.Start + 2, .Parent.End - 1)

           .Font.Bold = True: .Font.Color = wdColorBlue: .HighlightColorIndex = wdYellow

      End With

  Wend

End With

End Sub

Sub FindAndReplace()

Dim findText As String

Dim replaceText As String

Dim rng As range

' Prompt user for the text to find

findText = InputBox("Enter the text you want to find:", "Find Text")

' Prompt user for the replacement text

replaceText = InputBox("Enter the replacement text:", "Replace Text")

' Set the range to the entire document

Set rng = ActiveDocument.Content

' Execute the find and replace

With rng.Find

    .Text = findText

    .Replacement.Text = replaceText

    .Forward = True

    .Wrap = wdFindContinue

    .Format = False

    .MatchCase = False

    .MatchWholeWord = False

    .MatchWildcards = False

    .MatchSoundsLike = False

    .MatchAllWordForms = False

    .Execute Replace:=wdReplaceAll

End With

MsgBox "Find and Replace completed!", vbInformation

End Sub

Answer 1

To modify your script to find both "RICCARTON" and "NEW PLYMOUTH", you can adjust the .Text property in the Find object to include both terms. You can use the wildcard character to search for either term. Here’s how you can do it:

Replace this line:

.Text = "RICCARTON"

With:

.Text = "RICCARTON; NEW PLYMOUTH"

However, since the Find method does not support multiple search terms directly with a semicolon, you can use a workaround by executing the find operation twice, once for each term. Here’s an example of how you can implement this:

With f
    .ClearFormatting: .Text = "RICCARTON": .Wrap = wdFindStop
    Do While .Execute
        ' Your existing code to handle found instances
    Loop

    .ClearFormatting: .Text = "NEW PLYMOUTH": .Wrap = wdFindStop
    Do While .Execute
        ' Your existing code to handle found instances
    Loop
End With

This way, the script will search for both "RICCARTON" and "NEW PLYMOUTH" in the document and execute the necessary actions for each found instance.

Answer 2

It is only executing RICCARTON only, it is not doing the second loop which is NEW PLYMOUTH.