Replace upper case word in Word VBA - vba

Question

I am trying to replace words that are in all caps with a translated counterpart.
For example, I would like to replace the written number "ONE" with "UNO".
However, when "one" appears in the foreign language in various words it is replaced by "uno".
I only need to replace the capitalized word.
'ONE
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "ONE"
.Replacement.Text = "UNO"
.Forward = False
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
A better option might be to replace when it shows up as the whole word.
Edit: You just set .MatchWholeWord to true.

Answer 1

To do this in bulk you might use code like:
Sub MultiFindReplace()
Application.ScreenUpdating = False
Dim FList As String, RList As String, i As Long
FList = "ZERO|ONE|TWO|THREE|FOUR|FIVE|SIX|SEVEN|EIGHT|NINE|TEN|ELEVEN|TWELVE"
RList = "CERO|UNO|DOS|TRES|CUATRO|CINCO|SEIS|SIETE|OCHO|NUEVE|DIEZ|ONCE|DOCE"
With ActiveDocument.Range.Find
.ClearFormatting
.Replacement.ClearFormatting
.Format = False
.Forward = True
.MatchCase = True
.MatchWholeWord = True
'Process each item from the Find/Replace Lists
For i = 0 To UBound(Split(FList, "|"))
.Text = Split(FList, "|")(i)
.Replacement.Text = Split(RList, "|")(i)
.Execute Replace:=wdReplaceAll
Next
End With
Application.ScreenUpdating = True
End Sub

Answer 2

just set .MatchWholeWord to true!

Answer 3

To process content in headers, footers, endnotes, footnotes, etc., as well as the document body, you would use code like:
Sub MultiFindReplaceEverywhere()
Application.ScreenUpdating = False
Dim Rng As Range, Sctn As Section, Shp As Shape, HdFt As HeaderFooter, h As Long
With ActiveDocument
For Each Rng In .StoryRanges
Call FndRep(Rng)
For Each Shp In Rng.ShapeRange
With Shp
If Not .TextFrame Is Nothing Then
Call FndRep(.TextFrame.TextRange)
End If
End With
Next
Next
For Each Sctn In .Sections
For Each HdFt In Sctn.Headers
With HdFt
If .Exists = True Then
If .LinkToPrevious = False Then
Call FndRep(HdFt.Range)
For Each Shp In HdFt.Shapes
With Shp
If Not .TextFrame Is Nothing Then
Call FndRep(.TextFrame.TextRange)
End If
End With
Next
End If
End If
End With
Next
For Each HdFt In Sctn.Footers
With HdFt
If .Exists = True Then
If .LinkToPrevious = False Then
Call FndRep(HdFt.Range)
For Each Shp In HdFt.Shapes
With Shp
If Not .TextFrame Is Nothing Then
Call FndRep(.TextFrame.TextRange)
End If
End With
Next
End If
End If
End With
Next
Next
End With
Options.DefaultHighlightColorIndex = h
Application.ScreenUpdating = True
End Sub
Sub FndRep(Rng As Range)
Dim FList As String, RList As String, i As Long
FList = "ZERO|ONE|TWO|THREE|FOUR|FIVE|SIX|SEVEN|EIGHT|NINE|TEN|ELEVEN|TWELVE"
RList = "CERO|UNO|DOS|TRES|CUATRO|CINCO|SEIS|SIETE|OCHO|NUEVE|DIEZ|ONCE|DOCE"
With Rng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Format = False
.Forward = True
.MatchCase = True
.MatchWholeWord = True
'Process each item from the Find/Replace Lists
For i = 0 To UBound(Split(FList, "|"))
.Text = Split(FList, "|")(i)
.Replacement.Text = Split(RList, "|")(i)
.Execute Replace:=wdReplaceAll
Next
End With
End Sub