1 Attachment(s)
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