Sub NextNumberPlus()
' 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 - 1
If Asc(Selection) < 32 Then leftBit = ""
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
  If leftBit > "" Then
    .Text = leftBit & newNumber
  Else
    .Text = "^p" & newNumber
  End If
  .Replacement.Text = ""
  .Wrap = False
  .Forward = True
  .MatchWildcards = False
  .Execute
End With
Selection.End = Selection.Start
If Selection.End = hereNow Then beep
If leftBit > "" Then
  Selection.MoveRight Unit:=wdCharacter, Count:=4
Else
  Selection.MoveRight Unit:=wdCharacter, Count:=1
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