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

[macropod]

Try:

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.

[YengKW]

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?

[macropod]

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

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

[macropod]

Cross-posted at: http://www.msofficeforums.com/word-vba/40391-find-replace-numbers-macro-vba-microsoft-word.html
Please read VBA Express' Cross-Posting rule: http://www.vbaexpress.com/forum/faq.php?faq=new_faq_item#faq_new_faq_item3
It really is quite rude of you not to even acknowledge the assistance you've already received here.

[YengKW]

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.