0

I was thinking using the len but I don't know how to do it. If there is also a better way that you can do this can you please show and explain it. Thanks! :)

Sub Invalid()

    Dim e

    For Each e In Array("road", "street")

        Select Case e
            Case "road"
                Range("A1").EntireColumn.Replace e, "rd"
                
        End Select
    Next e

End Sub

Edit:

Still can't understand but what if it was only in the active cell and with this concept?

Dim Original As String
Dim Corrected As String
   
        Original = ActiveCell.Value
   
                Corrected = Replace(Original, "ROAD", "RD")
 


         ActiveCell.Value = Corrected

 

End Sub
  • There's no option to replace only whole words: you'd need to use something like the solution posted here: https://stackoverflow.com/questions/11728717/search-and-replace-whole-words-only – Tim Williams Sep 01 '20 at 23:48

1 Answers1

0

Using the basic approach outlined here: search and replace WHOLE WORDS ONLY

Sub ReplaceOnlyWords()
    Dim ws As Worksheet, c As Range
    Dim arrFind, arrReplaceWith, e, v
    
    arrFind = Array("road", "street")   'look for these words
    arrReplaceWith = Array("rd", "st")  'replace with these words
    
    Set ws = ActiveSheet
    For Each c In Application.Intersect(ws.UsedRange, ws.Columns(1)).Cells
        v = c.Value
        If Len(v) > 0 Then 'anything to work with?
            c.Value = ReplaceWords(v, arrFind, arrReplaceWith)
        End If
    Next c
End Sub

'In strSource, replace all words in FindThis with same-position word in ReplaceWith
Public Function ReplaceWords(strSource, FindThis, ReplaceWith) As String
    Dim re As Object, s, i As Long
    'check we got arrays and make so if not...
    'assuming both arrays if provided are the same length
    If Not IsArray(FindThis) Then FindThis = Array(FindThis)
    If Not IsArray(ReplaceWith) Then ReplaceWith = Array(ReplaceWith)
    s = strSource
    With CreateObject("VBScript.RegExp")
        .Global = True
        .IgnoreCase = True ' <-- case insensitve
        For i = LBound(FindThis) To UBound(FindThis)
            .Pattern = "\b" & FindThis(i) & "\b"
            s = .Replace(s, ReplaceWith(i))
        Next i
    End With
    ReplaceWords = s
End Function
Tim Williams
  • 154,628
  • 8
  • 97
  • 125