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?

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