Find and Replace VBA Word

[liquidace]

Hi

I'm hoping that you can help me. I want to be able to create a macro that finds all numbers with a "£" sign in front with 0 decimals and formats the number to a currency number with a coma thousand separator. So for example..

Finds £50000 and replaces it with £50,000
Finds £100000 and replaces it with £100,000
Find £1000000 and replaces it with £1,000,000 etc

This is what I have so far and it was working well until I noticed that it replaces 1000000 (1 million) to 100,0000 (coma is in wrong position) I think this because it finds 100000 earlier on in the document and replaces it with 100,000.

I hope I explained the problem ok? :think:


Dim selectedText As String
Dim oRng As Word.Range
Dim oRng1 As Word.Range
Set oRng = Word.ActiveDocument.Range
With oRng.Find
.Text = "£<[0-9]{4,9}"
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
While .Execute
If .Found = True Then
selectedText = oRng.Text
If IsNumeric(selectedText) Then
selectedText = Format(selectedText, "£#,##0;(£#,##0)")
Set oRng1 = Word.ActiveDocument.Range
With oRng1.Find
.Text = oRng.Text
.Replacement.Text = selectedText
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = True
.MatchWholeWord = True
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.Execute Replace:=wdReplaceAll
End With
End If

End If
Wend
End With

[gmaxey]

Sub TestII()
Dim oRng As Word.Range
Set oRng = Word.ActiveDocument.Range
With oRng.Find
.Text = "£<[0-9]{4,}"
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
While .Execute
oRng.MoveStart wdCharacter, 1
oRng.Text = FormatCurrency(oRng.Text, 0, False, True, True)
oRng.Characters.First.Delete
oRng.Collapse wdCollapseEnd
Wend
End With
End Sub

[liquidace]

Hi Greg

Prefect first time, thank you for your help :bow: