Option Explicit
Private oRngNum As Range
Sub FormatManualNumbering()
Dim oRng As Range
Dim oPar As Paragraph
    Application.ScreenUpdating = False
    Set oRng = ActiveDocument.Range
    oRng.InsertBefore vbCr
    With oRng.Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Forward = True
      .Wrap = wdFindStop
      .Format = False
      .MatchWildcards = False
      'Remove spaces starting paras:
      .Text = "^p^w"
      .Replacement.Text = "^p"
      .Execute Replace:=wdReplaceAll
    End With
    oRng.Characters(1).Delete
    For Each oPar In oRng.Paragraphs
      If IsNumeric(oPar.Range.Characters(1)) Then
        Set oRngNum = oPar.Range
        oRngNum.Collapse wdCollapseStart
        Do Until oRngNum.Characters.Last.Next Like "[A-Za-z]"
          oRngNum.MoveEnd wdCharacter, 1
        Loop
        ProcessNum
      End If
    Next
   Application.ScreenUpdating = True
lbl_Exit:
  Exit Sub
End Sub
Sub ProcessNum()
Dim oRng As Range
Dim lngIndex As Long
Dim bAllNums As Boolean
  bAllNums = True
  Set oRng = oRngNum.Duplicate
  oRng.Collapse wdCollapseEnd
  Do Until IsNumeric(oRng.Characters.First.Previous)
    oRng.MoveStart wdCharacter, -1
  Loop
  oRng.Text = "." & vbTab
  oRngNum.End = oRng.Start
  For lngIndex = 1 To oRngNum.Characters.Count
    If Not IsNumeric(oRngNum.Characters(lngIndex)) Then
      If oRngNum.Characters(lngIndex) = " " And oRngNum.Characters(lngIndex).Previous = "." Then
        oRngNum.Characters(lngIndex).Delete
        lngIndex = lngIndex + 1
      Else
        oRngNum.Characters(lngIndex) = "."
        bAllNums = False
      End If
    End If
  Next
  If Not bAllNums Then oRngNum.Characters.Last.Next.Delete
lbl_Exit:
  Exit Sub
End Sub