Sub DPU_Definitions()
Application.ScreenUpdating = False
With ActiveDocument
  With .Range
    'Convert list numbers to text'
    .ListFormat.ConvertNumbersToText
    'Create placeholder.
    .InsertBefore vbCr
    .Paragraphs(1).Range.Font.Bold = False
    With .Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Format = True
      .Forward = True
      .MatchWildcards = False
      .Wrap = wdFindContinue
      'Delete white spaces before paragraph breaks
      .Text = "^w^p"
      .Replacement.Text = "^p"
      .Execute Replace:=wdReplaceAll
      'Delete white spaces after paragraph breaks
      .Text = "^p^w"
      .Execute Replace:=wdReplaceAll
      'Clean up definitions
      .MatchWildcards = True
      .Text = "[:;, ^t]{1,5}means[:;, ]{1,5}"
      .Replacement.Text = "^t"
      .Replacement.Font.Bold = False
      .Execute Replace:=wdReplaceAll
      'Remove bold formatting from punctuation and para marks
      .Text = "[^13.;,:]"
      .Replacement.Text = "^&"
      .Font.Bold = True
      .Execute Replace:=wdReplaceAll
      'Clear space before tabs
      .Text = "[ ^160]{1,}^t"
      .Replacement.Text = "^t"
      .Execute Replace:=wdReplaceAll
      'Insert Bold quotes for bold definition text at beginning of sentence
      .Text = ""
      .Replacement.Text = "^034^&^034"
      .Wrap = wdFindStop
    End With
    Do While .Find.Execute = True
      With .Duplicate
        Do While .Characters.Last = " "
          .Characters.Last.Delete
        Loop
        .InsertBefore Chr(147)
        .InsertAfter Chr(148)
        If .Characters.First.Previous = vbCr Then
          .InsertAfter vbTab
          .Characters.Last.Font.Bold = False
        End If
      End With
      .End = .End + 1
      .Collapse wdCollapseEnd
    Loop
    With .Find
      .Wrap = wdFindContinue
      'insert tab at beginning of paragraph with a bracket e.g. (a), a), (i), i), (1), 1)
      .Text = "^13([\(a-z0-9]@\))"
      .Replacement.Text = "^p^t\1"
      .Execute Replace:=wdReplaceAll
      'Clear colons or commas after tabs.
      .Text = "[^t]([:\,]){1,}"
      .Replacement.Text = "^t"
      .Execute Replace:=wdReplaceAll
      'Clear space after tabs
      .Text = "^t[ ^160]{1,}"
      .Execute Replace:=wdReplaceAll
      'Highligt tabs so user can check for errors when code has run
      .Wrap = wdFindStop
      .Text = "^t"
    End With
    Do While .Find.Execute = True
      With .Duplicate
        .HighlightColorIndex = wdYellow
        .Start = .Paragraphs(1).Range.Start
        If Len(.Text) - Len(Replace(.Text, vbTab, "")) > 1 Then .Characters.Last.Text = " "
      End With
      .Collapse wdCollapseEnd
    Loop
  End With
  With .Range
    'Remove punctuation and insert semi-colon at end of sentence
    .Find.Text = "[! ^13]@[!.\!\?:;]^13"
    Do While .Find.Execute = True
      With .Duplicate
        Select Case Trim(.Words.First)
          Case "and", "but", "or", "then"
            'do nothing
          Case Else
          .Words.First.InsertAfter ";"
        End Select
      End With
      .Collapse wdCollapseEnd
    Loop
  End With
  'Remove placeholder.
  .Paragraphs(1).Range.Delete
  With .Range
    'Prefix designated bold first words with a tab
    .Find.Text = "^13[A-Za-z]"
    Do While .Find.Execute = True
      With .Duplicate.Paragraphs.Last.Range
        If .Style = "Normal" Then
          If .Characters.First.Font.Bold = False Then .InsertBefore vbTab
        End If
      End With
      .Collapse wdCollapseEnd
    Loop
  End With
End With
End Sub