Color Selected Texts with Red Color

[smallxyz]

Below is my attempted code.
However, it colors the texts of whole documents instead of the selected ones.
How should I amend it to become effective?



Sub Test
Call mCrRp("the", "wdColorRed", False)
End Sub

Sub mCrRp(ByVal f As String, _
ByVal Cr As String, _
ByVal bool As Boolean _)
Application.ScreenUpdating = False
'--------------------------------------
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Replacement.Font.Color = Cr
.Replacement.Highlight = bool


.Text = f
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = True
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False


.Execute replace:=wdReplaceAll
End With
'--------------------------------------
End Sub

Thanks in advance.

[gmayor]

You have several syntax issues however the following should do the job

Sub Test()
Call mCrRp("Lorem", wdRed, False) 'Note that it is wdRed not wdColorRed
End Sub

Sub mCrRp(ByVal f As String, _
ByVal Cr As Long, _
ByVal bool As Boolean) 'Cr is not a string variable when used here. See the note below about 'bool'
Dim orng As Range
Application.ScreenUpdating = False
'--------------------------------------
Set orng = Selection.Range
With orng.Find
Do While .Execute(f)
If orng.InRange(Selection.Range) Then
orng.Font.ColorIndex = Cr
If bool = False Then
orng.HighlightColorIndex = wdNoHighlight
Else
orng.HighlightColorIndex = wdYellow 'Highlight is not a true or false value
End If
orng.Collapse 0
End If
Loop
End With
lbl_Exit:
Application.ScreenUpdating = True
Exit Sub
End Sub

[smallxyz]

You have several syntax issues however the following should do the job

Sub Test()
Call mCrRp("Lorem", wdRed, False) 'Note that it is wdRed not wdColorRed
End Sub

Sub mCrRp(ByVal f As String, _
ByVal Cr As Long, _
ByVal bool As Boolean) 'Cr is not a string variable when used here. See the note below about 'bool'
Dim orng As Range
Application.ScreenUpdating = False
'--------------------------------------
Set orng = Selection.Range
With orng.Find
Do While .Execute(f)
If orng.InRange(Selection.Range) Then
orng.Font.ColorIndex = Cr
If bool = False Then
orng.HighlightColorIndex = wdNoHighlight
Else
orng.HighlightColorIndex = wdYellow 'Highlight is not a true or false value
End If
orng.Collapse 0
End If
Loop
End With
lbl_Exit:
Application.ScreenUpdating = True
Exit Sub
End Sub

gmayor, very nice. Thank you very much!