Find and Replace Numbers

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!

Code:

---

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

---

Try:

Code:

---

Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "[0-9]{1,}"
    .Replacement.Text = ""
    .Format = True
    .Highlight = True
    .Forward = True
    .Wrap = wdFindStop
    .MatchWildcards = True
    .Execute
  End With
  Do While .Find.Found
    If .HighlightColorIndex = wdYellow Then
      .Text = "x"
      .HighlightColorIndex = wdBlack
    End If
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
End Sub

---

PS:When posting code, please post formatted code and use the code tags, indicated by the # button on theposting menu. Without them, your code loses much of whatever structure it had.

Hi Paul,
this is great. Is there a way where you can get a one to one character replacement?
For example with your macro the number 25 becomes 'x'. Is there a way to get it to change to 'xx' and so on?

You could just delete {1,}, but that might make the code run quite slowly. Instead, try:

Code:

---

Sub Demo()
Application.ScreenUpdating = False
Dim i As Long, StrTxt As String
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "[0-9]{1,}"
    .Replacement.Text = ""
    .Format = True
    .Highlight = True
    .Forward = True
    .Wrap = wdFindStop
    .MatchWildcards = True
    .Execute
  End With
  Do While .Find.Found
    If .HighlightColorIndex = wdYellow Then
      StrTxt = ""
      For i = 1 To Len(.Text)
        StrTxt = StrTxt & "x"
      Next
      .Text = StrTxt
      .HighlightColorIndex = wdBlack
    End If
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
End Sub

---

Cross-posted at: http://www.msofficeforums.com/word-v...soft-word.html
Please read VBA Express' Cross-Posting rule: http://www.vbaexpress.com/forum/faq...._new_faq_item3
It really is quite rude of you not to even acknowledge the assistance you've already received here.

Thank you Macropod. Code works perfectly. I have read the double post rule and deleted the double post on the other forum. Full credit goes to you for solving my issue. Thanks again for your help.