Sub NumberIncrement()
' Paul Beverley - Version 18.01.23
' Adds one to the next number after the cursor

myJump = 1

goNext = False
' goNext = True

trackIt = True

searchRange = 100

If goNext = True And Selection.Start <> _
     Selection.End Then _
     Selection.Collapse wdCollapseStart

myTrack = ActiveDocument.TrackRevisions
If trackIt = False Then ActiveDocument.TrackRevisions = False

Set rng = Selection.Range.Duplicate
rng.End = rng.Start + searchRange

Do While InStr(" .", Left(rng, 1)) > 0
  rng.MoveStart , 1
Loop

' Move selection to start of any number
If Val(rng) = 0 Then
  i = 0
  allText = rng.Text
  Do
    i = i + 1
    If i = searchRange Then
      Beep
      rng.Start = rng.End - 1
      rng.Select
      Exit Sub
    End If
    myTest = Mid(allText, i)
    DoEvents
  Loop Until Val(myTest) > 0 And Left(myTest, 1) <> " " _
       And Left(myTest, 1) <> "."
  Selection.MoveStart , i - 1
  rng.MoveStart , i - 1
End If

' Find end of number and increment (decrease) it
i = 0
allText = rng.Text
Do
  i = i + 1
  myTest = Mid(allText, i, 1)
  DoEvents
Loop Until Val(myTest) = 0 And myTest <> "0"
rng.End = rng.Start + i - 1
rng.Select
rng.Text = Trim(Str(Val(rng.Text) + myJump))
If goNext = True Then
  Do While Asc(Selection) > 47 And Asc(Selection) < 58
    Selection.MoveRight , 1
  Loop
  Call FindFwd
End If
End Sub