Sub DPU_AutoNumbering_Schedule_ExcTables()
Application.ScreenUpdating = False
Dim Para As Paragraph, Rng As Range, iLvl As Long, i As Paragraph, n As Long, StyleName As String, wrd As Long, Count As Long
ActiveDocument.Range.Style = "Body Text"
With Selection.Range
For Each i In ActiveDocument.Paragraphs 'Remove all leading spaces e.g tabs, spaces, NBS
For n = 1 To i.Range.Characters.Count
If i.Range.Characters(1).Text = " " Or i.Range.Characters(1).Text = " " Or i.Range.Characters(1).Text = Chr(9) Or i.Range.Characters(1).Text = Chr(160) Then
i.Range.Characters(1).Delete
Else: Exit For
End If
Next n
Next
    For Each Para In .Paragraphs
    If Para.Range.Information(wdWithInTable) = False Then
      Set Rng = Para.Range.Words.First 'Convert manual numbering to Schedule Level numbering
      With Rng
        If IsNumeric(.Text) Then
          While .Characters.Last.Next.Text Like "[0-9. " & vbTab & "]"
            .End = .End + 1
          Wend
          iLvl = UBound(Split(.Text, "."))
          If IsNumeric(Split(.Text, ".")(UBound(Split(.Text, ".")))) Then iLvl = iLvl + 1
          If iLvl < 10 Then
            .Text = vbNullString
            Para.Style = "Schedule Level " & iLvl
           End If
        End If
      End With
    End If
  Next
End With
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
         .Wrap = wdFindContinue
         .Forward = True
         .Format = True
    .MatchWildcards = False
    .Style = "Schedule Level 1" 'format Schedule Level 1 bold
    .Font.Bold = False
        .Text = ""
        .Replacement.Font.Bold = True
        .Replacement.Text = ""
        .Execute Replace:=wdReplaceAll
   End With
   With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
         .Wrap = wdFindContinue
         .Forward = True
         .Format = True
    .MatchWildcards = False
    .Style = "Body Text"
        .Text = ""
        .Replacement.Style = "Body1"
        .Replacement.Font.Bold = False
        .Replacement.Text = ""
        .Execute Replace:=wdReplaceAll
        
     End With
   Application.ScreenUpdating = True
   
End Sub