How to Find&Replace with MatchWholeWord?

[JS]

Hi All:
I need to Find and Replace text in excel, however I'm bumping into a
problem: parts of longer words are being found by shorter words and these
parts are being then replace with the ReplaceWith text.
Word's VBA has the "MatchWholeWord Property" that avoids this problem.
Does anyone know if there is a way to do this "MatchWholeWord" in Excel VBA?
Thanks for your help, JS

 

[Guest]

LookAt:=xlWhole

 

[Tom Ogilvy]

in code, in the find statement change

LookAt:=xlPart

to

LookAt:=xlWhole

but this is for the whole value of a cell. There isn't an option that would
correctly interpret

What:="the"
With:="pig"

to ignore "Look there, John, see, the is pink"

xlWhole would ignore the string
xlPart would do "Look pigre, John, see, pig is pink"

Think you would be left with programming your own solution using regular
expressions or build your own parser.

 

[Guest]

Hi Tom,

Perhaps a workaround in this case might be (?)

What:=" the "

Anthony

 

[Tom Ogilvy]

Certainly not a general workaround. Doesn't account for punctuation or
position.

 

[JS]

Hi: Following Tom's suggestion, I threw together some code which *seems* to
work, but isn't gentle on formatting...

....
If InStr(sFirst, " ") > 0 Then 'if spaces in find string
Cells.Replace What:=sFirst, Replacement:=sLast, LookAt:=xlPart,
SearchOrder:=xlByRows, MatchCase:=True
Else ' whole word to find
Set Fndrng = Find_Range(sFirst, Range("A1",
ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell))) '
If Not Fndrng Is Nothing Then
For Each c In Fndrng.Cells
If Not c Is Nothing Then
Txt = c.Cells.text
If InStr(Txt, " ") > 0 Then
Ar() = Split(Txt)
For I = 0 To UBound(Ar)
If Ar(I) = sFirst Then Ar(I) = sLast
Next
xxx = Join(Ar)
c.Cells = Join(Ar)
Else
If Txt = sFirst Then c.Cells = sLast
End If
End If
Next c
End If
End If
....
=========================
Function Find_Range(Find_Item As String, Search_Range As Range, _
Optional LookIn As Variant, Optional LookAt As Variant, _
Optional MatchCase As Boolean) As Range

Dim c As Range, Lista As String
If IsMissing(LookIn) Then LookIn = xlValues 'xlFormulas
If IsMissing(LookAt) Then LookAt = xlPart 'xlWhole
If IsMissing(MatchCase) Then MatchCase = True
With Search_Range
Set c = .Find(What:=Find_Item, LookAt:=xlPart, LookIn:=xlValues,
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True)
If c Is Nothing Then Set c = .Find(What:=Find_Item, LookAt:=xlWhole,
LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=True)
If Not c Is Nothing Then
Set Find_Range = c
Lista = "|" & Find_Item & "|" & "Found at cells:" & vbCrLf & c.Address
firstAddress = c.Address
Do
Set Find_Range = Union(Find_Range, c)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
End Function