Find and Replace Numbers

[YengKW]

Hi all,

I'm trying to create a macro that will replace numerical values in only yellow highlighted texts to 'x' and then highlights to black.
At the moment my code works for all highlighted texts not just yellow.
The first part of the code is really the issue as the code only looks for numerical characters in any highlighted text. How can I change this to make it only identify yellow highlighted texts?
And can anyone suggest how this whole code (part one and two) can be more efficient?

Any help would be appreciated!

Sub NbrChange()

Application.ScreenUpdating = False

Lookfor = "1234567890"
Dim i As Long
For i = 1 To Len(Lookfor)
  Lookchar = Mid$(Lookfor, i, 1)
  Selection.Find.ClearFormatting
  Selection.Find.Replacement.ClearFormatting
  With Selection.Find
    .Text = Lookchar
    .Replacement.Text = "x"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchCase = True
    .MatchAllWordForms = False
    .Highlight = True
    
  End With
  Selection.Find.Execute Replace:=wdReplaceAll
Next
Dim r As Range
Set r = ActiveDocument.Range
With r.Find
  .Highlight = True
  Do While .Execute
    If r.HighlightColorIndex = 7 Then
      r.HighlightColorIndex = 1
    End If
  Loop
End With
Application.ScreenUpdating = True
End Sub