Sub NextNumber()
' Paul Beverley - Version 11.10.10
' Find next section number
allowedChars = "0123456789."
theNumber = ""
Selection.End = Selection.Start
startPos = Selection.Start
Selection.Start = startPos - 4
leftBit = Selection
Selection.Start = startPos
pos = 1
dotPos = 0
Do
  thisChar = Selection
  theNumber = theNumber + thisChar
  If thisChar = "." Then
    prevDotPos = dotPos
    dotPos = pos
  End If
  Selection.MoveRight Unit:=wdCharacter, Count:=1
  pos = pos + 1
Loop Until InStr(allowedChars, thisChar) = 0
If dotPos > 0 Then
  lastNumber = Mid(theNumber, dotPos + 1, pos - dotPos - 2)
  If Val(lastNumber) = 0 Then
    dotPos = prevDotPos
    lastNumber = Mid(theNumber, dotPos + 1, pos - dotPos - 2)
  End If
  newNumber = Left(theNumber, dotPos) + Trim(Str(Val(lastNumber) + 1))
Else
  lastNumber = Left(theNumber, pos - 2)
  newNumber = Trim(Str(Val(lastNumber) + 1))
End If
hereNow = Selection.End
With Selection.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Text = newNumber
  .Replacement.Text = ""
  .Wrap = False
  .Forward = True
  .MatchWildcards = False
  .Execute
End With
If Selection.End = hereNow Then
  beep
  Selection.End = startPos
End If
'Add this to leave F&R dialogue in a sensible state
With Selection.Find
  .Wrap = wdFindContinue
End With
Selection.End = Selection.Start
End Sub