VBA Help with Text to Table issue

[Shelley_Lou]

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.



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

[gmayor]

The reason for the lack of formatting is the line

.Range.Style = "Definition Level 1"
As for the 'means' the following should work

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

[Shelley_Lou]

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.