Sub Test_TextToTables()
Dim rRng As Range, rCell As Range 'Convert text to table
Dim oBorder As Border
Dim oTbl As Table
Dim i As Integer
Application.ScreenUpdating = False
Set rRng = ActiveDocument.Range
Set oTbl = rRng.ConvertToTable(Separator:=wdSeparateByTabs, NumColumns:=2, AutoFitBehavior:=wdAutoFitFixed)
With oTbl
   .Style = "Table Grid"
   .ApplyStyleHeadingRows = True
   .ApplyStyleLastRow = False
   .ApplyStyleFirstColumn = True
   .ApplyStyleLastColumn = False
   .Columns.PreferredWidth = InchesToPoints(2.7)
   .Columns(2).PreferredWidth = InchesToPoints(3.63)
For Each oBorder In .Borders
   oBorder.LineStyle = wdLineStyleNone
Next oBorder
For i = 1 To .Rows.count 'check each row
   Set rCell = .Cell(i, 1).Range 'set a range to the cells in column 1
   rCell.Style = "DefBold" 'apply the style to the range
   Set rCell = .Cell(i, 2).Range  'set a range to the cells in column 2
   rCell.Collapse 1 'collapse the range to its start
   rCell.MoveEndWhile Chr(32) 'move the end of the range to include any following spaces
   rCell.text = "" 'and empty the range
For Each oTbl In ActiveDocument.Tables
    Set rRng = oTbl.Range
    rRng.End = rRng.End - 2
    If rRng.Characters.Last = ";" Then rRng.Characters.Last = "."
  Next oTbl
'End If
   Next i
   End With
   'Call DPU_TableLeadingSpaces
   Call DPU_ApplyDefinitionStylesToTable
Application.ScreenUpdating = True
Set rRng = Nothing
Set oTbl = Nothing
Set rCell = Nothing
Set oBorder = Nothing
End Sub

Sub Test_ApplyDefinitionStylesToTable()
'Apply housestyle definition numbering to column 2 of table
Application.ScreenUpdating = False
Dim r As Long, i As Long, rCell As Range, oTbl As Table, rRng As Range
With ActiveDocument.Tables(1)
For r = 1 To .Rows.count
With .Cell(r, 2).Range
   If .Characters.First <> "(" Then
   .Style = "Definition Level A"
   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

Sub Enter_Wd()

Dim oRng As range
Set oRng = selection.range
    oRng.Find.ClearFormatting
    oRng.Find.Replacement.ClearFormatting
    With oRng.Find
        .text = "(^9)\("
        .Replacement.text = "\1means("
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
        .Execute Replace:=wdReplaceAll
    End With
End Sub

        .text = "(^34^9)\("

Sub Enter_Wd()
Dim oRng As Range
Set oRng = Selection.Range
    oRng.Find.ClearFormatting
    oRng.Find.Replacement.ClearFormatting
    With oRng.Find
    .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
        .text = "(^34^9)\("
        .Replacement.text = "\1means ("
        .Replacement.Font.Bold = False
        .Execute Replace:=wdReplaceAll
    End With
End Sub

Sub Insert_Wd()

Dim oRng As range
Set oRng = selection.range
    oRng.Find.ClearFormatting
    oRng.Find.Replacement.ClearFormatting
    With oRng.Find
        .text = "(^34^9)\("
        .Replacement.text = "\1means("
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
        .Execute Replace:=wdReplaceAll
        .text = "means\("
        .Replacement.text = "^&"
        .Replacement.Font.Bold = False
        .Execute Replace:=wdReplaceAll
    End With
End Sub