Consulting

Results 1 to 3 of 3

Thread: VBA Help with Text to Table issue

  1. #1

    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.


    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
    Attached Files Attached Files

  2. #2
    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
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    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.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •