Try:
Sub Demo()
Application.ScreenUpdating = False
Dim i As Long, Rng As Range
Set Rng = Selection.Range
With Selection.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "<[0-9,.]{6,}"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.MatchWildcards = True
.Execute
End With
Do While .Find.Found
If .InRange(Rng) = False Then Exit Do
If .Characters.Last Like "[,.]" Then .End = .End - 1
i = Round(.Text / 1000, 0)
Select Case i
Case Is < 1000
Case Is > 999999: .Text = Format(Round(.Text / 1000000000, 2), "#.00") & "B"
Case Else: .Text = Format(Round(.Text / 1000000, 2), "#.00") & "M"
End Select
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
Application.ScreenUpdating = True
End Sub