'Delete all periods immediately before a tab:
            While rng.Characters.Last.Previous = "."

Sub FormatManualNumbering()
Dim rng As Range
Dim rngEnd As Long
Dim i As Paragraph, N As Long
Application.ScreenUpdating = False
'Call DeleteEmptyParas
'Call DPU_RemoveFirstLineIndents
If Selection.Type = wdSelectionIP Then
 MsgBox Prompt:="You have not selected any text!"
 Exit Sub
End If
With Selection.Range
Set rng = Selection.Range
With rng
'Removes any indents at beginning of paragraphs
For Each i In Selection.Paragraphs 'cycling in the pragraphs of the active document
For N = 1 To i.Range.Characters.count
If i.Range.Characters(1).text = " " Or i.Range.Characters(1).text = "Char(32) " Or i.Range.Characters(1).text = "Char(32)\( " Or i.Range.Characters(1).text = Chr(9) Or i.Range.Characters(1).text = Chr(160) Or i.Range.Characters(1).text = Chr(40) Then
i.Range.Characters(1).Delete
Else: Exit For
End If
Next N
Next
End With
With Selection.Range
Set rng = Selection.Range
With rng.Find
'Remove space before brackets first line indent
    .ClearFormatting
    .Replacement.ClearFormatting
    .text = "^13 ("
        .Replacement.text = "^p("
     .Execute Replace:=wdReplaceAll
End With
With Selection.Range
    Set rng = Selection.Range
    rngEnd = rng.End
    Selection.Range.InsertBefore vbCr
       With rng.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
'Remove spaces before para signs:
        .text = "^w^p"
        .Replacement.text = "^p"
        .Execute Replace:=wdReplaceAll
'Remove empty paras:
        .MatchWildcards = True
        .text = "^13{2,}"
        .Replacement.text = "^p"
        .Execute Replace:=wdReplaceAll
'Insert a tab before any 1st letter in a para:
        .text = "(^13[!^13]@)([A-Za-z])"
        .Replacement.text = "\1^t\2"
        .Execute Replace:=wdReplaceAll
'Replace two tabs with one tab:
        .text = "^t^t"
        .Replacement.text = "^t"
        .Execute Replace:=wdReplaceAll
'Delete tabs between letters, which have been inserted using
'the code to insert a tab before any 1st letter in a para previously:
        .text = "([A-Za-z])^t([A-Za-z])"
        .Replacement.text = "\1\2"
        .Execute Replace:=wdReplaceAll
    End With
With Selection.Range
Set rng = Selection.Range
    Do
        With rng.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .Forward = True
            .Wrap = wdFindStop
            .Format = True
            .MatchWildcards = True
'Find a str between a tab & the nearest previous para sign, i.e.
'a str between a para sign & a tab, excluding other paras in-between:
            .text = "^13[!^13]@^t"
            If .Execute And rng.End <= rngEnd Then
                .text = "[,:; ]"
                .Replacement.text = "."
                .Execute Replace:=wdReplaceAll
            Else: Exit Do
            End If
'Delete all periods immediately before a tab:
            While rng.Characters.Last.Previous = "."
                rng.Characters.Last.Previous.Delete
            Wend
            rng.Collapse wdCollapseEnd
        End With
    Loop
'Reset rng (see the comment above):
    With Selection.Range
Set rng = Selection.Range
With rng.Find
         .ClearFormatting
        .Replacement.ClearFormatting
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
        .MatchWildcards = True
'Insert periods after lone 1st-level numberings:
        .text = "(^13[0-9]{1,})^t"
        .Replacement.text = "\1.^t"
        .Execute Replace:=wdReplaceAll
'Delete extra periods in the doc:
        .text = "[.]{2,}"
        .Replacement.text = "."
        .Execute Replace:=wdReplaceAll
'Delete tab after opening bracket:
        .text = "(^13[(])^t"
        .Replacement.text = "\1"
        .Execute Replace:=wdReplaceAll
'Delete tab after opening double quote (Chr(34) & Chr(147)) after para marks:
        .text = "(^13" & "[" & Chr(34) & Chr(147) & "]" & ")^t"
        .Replacement.text = "\1"
        .Execute Replace:=wdReplaceAll
    End With
'Delete the doc's starting para sign inserted previously:
    Selection.Range.Characters.First.Delete
 Application.ScreenUpdating = True
MsgBox "Complete"
  End With
  End With
  End With
  End With
  End With
Set rng = Nothing
End Sub