The following will do what you ask - at least with the example text. Donations may be made to the link on my web site http://www.gmayor.com
Option Explicit
Sub Macro1()
Dim oRng As Range, oFind As Range
Dim iCount As Long
Dim sText As String, strExt As String
Dim bFound As Boolean
iCount = 0
Do
bFound = False
Set oRng = ActiveDocument.Range
With oRng.Find
Do While .Execute(FindText:="(R[0-9]{1,})([\],])", MatchWildcards:=True) = True
If Val(ExtractDigits(oRng.Text)) <= 1000 Then
bFound = True
Exit Do
End If
Loop
End With
If Not bFound Then GoTo lbl_Restore
Set oRng = ActiveDocument.Range
With oRng.Find
Do While .Execute(FindText:="(R[0-9]{1,})([\],])", MatchWildcards:=True) = True
If Val(ExtractDigits(oRng.Text)) <= 1000 Then
iCount = iCount + 1
sText = oRng.Text
sText = Trim(Replace(sText, ",", ""))
sText = Trim(Replace(sText, "]", ""))
Set oFind = ActiveDocument.Range
With oFind.Find
.Text = sText & "([!0-9])"
.Replacement.Text = "R" & iCount + 1000 & "\1"
Do While .Execute(MatchWildcards:=True, Replace:=wdReplaceAll)
Loop
End With
End If
Loop
End With
Loop
lbl_Restore:
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = "(R[0-9]{1,})([\],])"
.Replacement.Text = "\1"
Do While .Execute(FindText:="(R[0-9]{1,})([\],])", MatchWildcards:=True) = True
strExt = Right(oRng.Text, 1)
If Val(ExtractDigits(oRng.Text)) > 1000 Then
oRng.Text = "R" & CStr(Val(ExtractDigits(oRng.Text)) - 1000) & strExt
End If
oRng.Collapse 0
Loop
End With
lbl_Exit:
Exit Sub
End Sub
Private Function ExtractDigits(strText As String) As String
'Graham Mayor
Dim i As Integer
ExtractDigits = ""
For i = 1 To Len(strText)
If Mid(strText, i, 1) >= "0" And _
Mid(strText, i, 1) <= "9" Then
ExtractDigits = ExtractDigits + Mid(strText, i, 1)
End If
Next
lbl_Exit:
Exit Function
End Function