VBA Remove manual numbering after Outline numbering

[Shelley Lou]

Views: 11 Size: 29.1 KB">TEST DOC FOR MANUAL NUMBERING.docx

Hi Guys
When converting documents from pdf to Word, I copy the text and paste into my template as unformatted text, I then go through and insert house style numbering. The macro below removes the manual numbering for Headings 1-6. The macro works but doesn't correctly line the paragraphs up re hanging at 0.5". When I do the steps as a find and replace it works but when put into VBA it doesn't work so not sure what I am doing wrong. I've tried putting .Replacement.Style = Heading 2 for example and that doesn't do anything for lining up the paragraphs.

The code at the moment only includes if the manual numbering is followed by a tab, but needs to include if it is a space as well.

Can anyone help at all.
Thanks, Shelley

Numbering.PNG

Sub DPU_RemoveManualNumbering()
Application.ScreenUpdating = False

With ActiveDocument
  With Range.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True

With Range.Find
    .Find.ClearFormatting
    .Find.Replacement.ClearFormatting
    .Text = "([0-9]@^t)(*)" 'Remove manual numbers from Heading 1
    .Replacement.Text = "\2"
    .MatchWildcards = True
    .Execute Replace:=wdReplaceAll
      
    .Find.ClearFormatting
    .Find.Replacement.ClearFormatting
    .Text = "([0-9]@.[0-9]@^t)(*)" 'Remove manual numbers from Heading 2
    .Replacement.Text = "\2"
    .MatchWildcards = True
    .Execute Replace:=wdReplaceAll
    
    .Find.ClearFormatting
    .Find.Replacement.ClearFormatting
    .Text = "([0-9]@.[0-9]@.[0-9]@^t)(*)" 'Remove manual numbers from Heading 3
    .Replacement.Text = "\2"
    .MatchWildcards = True
    .Execute Replace:=wdReplaceAll
    
     .Find.ClearFormatting
    .Find.Replacement.ClearFormatting
    .Text = "([0-9]@.[0-9]@.[0-9]@^t)(*)" 'Remove manual numbers from Heading 4
    .Replacement.Text = "\2"
     .MatchWildcards = True
    .Execute Replace:=wdReplaceAll
        
    .Find.ClearFormatting
    .Find.Replacement.ClearFormatting
    .Text = "([\(][a-z][\)]@^t)(*)" 'Remove manual letters and/or Roman numerals from Heading 5 & 6
    .Replacement.Text = "\2"
    .MatchWildcards = True
    .Execute Replace:=wdReplaceAll
    
          
   .Find.ClearFormatting
    .Find.Replacement.ClearFormatting
    .Text = "([\(][A-Z][\)]@^t)(*)" 'Remove manual Uppercase letters in brackets from Heading 7
    .Replacement.Text = "\2"
    .MatchWildcards = True
    .Execute Replace:=wdReplaceAll
    
    End With
         
    Application.ScreenUpdating = True
End Sub