Sub DPU_ApplyHeadingStylesTable()
Application.ScreenUpdating = False
Dim r As Long, i As Long
With ActiveDocument.Tables(1)
  For r = 1 To .Rows.Count
    With .Cell(r, 2).Range
      If .Characters.First <> "(" Then
        .Style = "DefText"
      Else
        i = Asc(Split(Split(.Text, "(")(1), ")")(0))
        Select Case i
          Case 97 To 104, 106 To 117, 119, 121 To 122: .Style = "Definition Level 1" 'LowercaseLetter
          Case 105, 118, 120: .Style = "Definition Level 2" 'LowercaseRoman
          Case 65 To 90: .Style = "Definition Level 3" 'UppercaseLetter
          Case 48 To 57: .Style = "Definition Level 4" 'Arabic
          
        End Select
        .Collapse wdCollapseStart
        .MoveEndUntil " "
        .End = .End + 1
        .Delete
      End If
    End With
  Next
End With
Application.ScreenUpdating = True
End Sub