Invoking if/then within find/replace routine-CodePudding

I have a macro to perform various tech editing tasks in technical documents. One task is to ensure large numbers have commas in the correct locations. My routine to insert commas works fine, but also includes dates, street #s, etc (e.g., 15 January 2,022 and 1,234 Smith Street). I am now attempting to correct the street addresses using the routine below, but am doing something wrong with my looping. Currently, it is only finding/fixing the first instance of a street number with a comma in it, then it stops looping.

Please note that the current code snippet below include several commented commands that I tried during my troubleshooting ...

What am I missing?

'remove commas from street addresses
Set oRange = ActiveDocument.Range
With oRange.Find
    'Set the search conditions
    .ClearFormatting
    .Text = "(<[0-9]{1,2})(,)([0-9]{3})"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchWildcards = True
    .Execute
    
    'If .Found Then
    Do While .Found
        oRange.Select 'for debugging purposes
        If (InStr(1, "NorthEastWestSouth", Trim(oRange.Words(3).Next(wdWord, 1)), 0) <> 0 And Len(Trim(oRange.Words(3).Next(wdWord, 1))) > 1) Or _
            (InStr(1, "StreetAvenueRoadRdBoulevardBlvdPikeCircleHighwayHwyCourtCtLaneWayParkwayAlleyBypassEsplanadeFreewayJunctionRouteRteTraceTrailTurnpikeVille", _
                Trim(oRange.Words(3).Next(wdWord, 2)), 0) <> 0 And Len(Trim(oRange.Words(3).Next(wdWord, 2))) > 1) Or _
            (InStr(1, "StreetAvenueRoadRdBoulevardBlvdPikeCircleHighwayHwyCourtCtLaneWayParkwayAlleyBypassEsplanadeFreewayJunctionRouteRteTraceTrailTurnpikeVille", _
                Trim(oRange.Words(3).Next(wdWord, 3)), 0) <> 0 And Len(Trim(oRange.Words(3).Next(wdWord, 3))) > 1) Or _
            InStr(1, "N.E.W.S.", Trim(oRange.Words(3).Next(wdWord, 1) & Trim(oRange.Words(3).Next(wdWord, 2))), 0) <> 0 Then
               .Replacement.Text = "\1\3"
               .Execute Replace:=wdReplaceAll
               'oRange.Text = VBA.Replace(oRange.Text, ",", "")
        End If
        '.Execute
    'End If
    Loop 'continue finding
End With

CodePudding user response：

Try:

Sub Demo()
Application.ScreenUpdating = False
Dim StrFnd As String, i As Long
StrFnd = "Alley|Avenue|Av|Boulevard|Blvd|Bypass|Circuit|Crct|Circle|Crcl|Court|Ct|Esplanade|Esp|Freeway|Fwy|" & _
    "Junction|Jnc|Highway|Hwy|Lane|Ln|Way|Parkway|Pike|Road|Rd|Street|St|Route|Rt|Trace|Trail|Turnpike|Ville"
With ActiveDocument.Range.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Forward = True
  .Wrap = wdFindContinue
  .Format = False
  .MatchWildcards = True
  'Process dates
  .Text = "([JFMASOND][anuryebchpilgstmov]{2,8} [12]),([0-9]{3})>"
  .Replacement.Text = "\1\2"
  .Execute Replace:=wdReplaceAll
  'Process addresses
  For i = 0 To UBound(Split(StrFnd, "|"))
    .Text = "([0-9]),([0-9]{3} <[A-Z][a-z]@> " & Split(StrFnd, "|")(i) & ")"
    .Execute Replace:=wdReplaceAll
    .Text = "([0-9]),([0-9]{3} <[A-Za-z]@> <[A-Z][a-z]@> " & Split(StrFnd, "|")(i) & ")"
    .Execute Replace:=wdReplaceAll
  Next
End With
Application.ScreenUpdating = True
End Sub

Not sure what you're trying to achieve with 'NorthEastWestSouth' and 'N.E.W.S.'