Sub DPU_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
Call DPU_ApplyDefinitionStylesToTable
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 "means,:" 'move the end of the range to include any of these characters
   If rCell.text Like "means*" Then 'if that range starts with 'means'
   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
Application.ScreenUpdating = True
Set rRng = Nothing
Set oTbl = Nothing
Set rCell = Nothing
Set oBorder = Nothing
End Sub

Sub DPU_ApplyDefinitionStylesToTable()
'Apply housestyle definition numbering to column 2 of table
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 = "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 DPU_TableLeadingSpaces()
'Remove any leading spaces in table row cells
Application.ScreenUpdating = False
Dim Tbl As Table, Cll As Cell
For Each Tbl In ActiveDocument.Tables
  For Each Cll In Tbl.Range.Cells
    With Cll.Range
      If Len(.text) > 2 Then
        Do While .Characters.First.text = " "
          .Characters.First.text = vbNullString
        Loop
      End If
      If Len(.text) > 2 Then
        Do While .Characters.Last.Previous.text = " "
          .Characters.Last.Previous.text = vbNullString
        Loop
      End If
    End With
  Next
Next
Application.ScreenUpdating = True
End Sub