VBA Help with Text to Table issue

I have been using the code below to convert my definitions list into a 2 column table for a while now but I've noticed that when converted to a table it is stripping any previous formatting e.g. stripping bold (or italics) from definitions within the same paragraph ("Planning Consent") or "Statutory Consent" (see attached example document of a before and after). How can I prevent the formatting being stripped in column 2?

I would also like to remove the first word of each cell in Column 2 if it begins with the word 'means' or 'means,' or 'means:' but only at the beginning and not if it appears elsewhere in the cell. I can't seem to get the code working correctly and I've search the forum and Google but having no luck finding an answer. Any ideas would be very much appreciated.

Code:

---

Sub DPU_Test_TextToTables()Dim aRng As Range, oBorder As Border, aTbl As Table, aCell As Cell
Application.ScreenUpdating = False
Set aRng = ActiveDocument.Range
Set aTbl = aRng.ConvertToTable(Separator:=wdSeparateByTabs, NumColumns:=2, AutoFitBehavior:=wdAutoFitFixed)
With aTbl
.Style = "Table Grid"
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = False
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = False
.Range.Style = "Definition Level 1"
For Each aCell In .Columns(1).Cells
aCell.Range.Style = "DefBold"
Next aCell
.Columns.PreferredWidthType = wdPreferredWidthPoints
.Columns.PreferredWidth = InchesToPoints(2.7)
.Columns(2).PreferredWidth = InchesToPoints(3.63)
For Each oBorder In .Borders
oBorder.LineStyle = wdLineStyleNone
Next oBorder


For Each aCell In .Columns(2).Cells
If aCell.Range.Words.First = "means" Then
aCell.Range.Words.First.Delete
Else
End If
Next aCell


End With
Application.ScreenUpdating = True
End Sub

---

The reason for the lack of formatting is the line

Code:

---

.Range.Style = "Definition Level 1"

---

As for the 'means' the following should work

Code:

---

Sub DPU_Test_TextToTables()
Dim rRng As Range, rCell As Range
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 "aemns,:" '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
            End If
        Next i

    End With
    Application.ScreenUpdating = True
    Set rRng = Nothing
    Set oTbl = Nothing
    Set rCell = Nothing
    Set oBorder = Nothing
End Sub

---

Hi Graham, I have tested this today on a 100 page lease conversion with many definition pages and it worked perfectly, many thanks for your help it is very much appreciated as always, best wishes, Shelley.