Convert particular blocks of text within a word document to tables using macro

Hi Experts,

I want reformat a large word document (1000 pages) so that, wherever in the document the blue text ( as shown in the attachment) is discovered it converts it to a table


The text color should remain as the original, in the document before reformatting.
The font should be as the table
The items next to the blue text differs and should be the second column of the table. The table will be 2 columns and 7 rows.

I have tried to do this, using a macro, which logically i can see is possible but  I am failing...  I would really appreciate your help - Thank you in advance
exmaple.docx
benja123Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

GrahamSkanRetiredCommented:
Since the text is interspersed with non-blue text, there is no way in the example document to tell where the potential tables start and end.
This will convert the whole document to a two-column table.
Sub ToTable()
    Dim rng As Range
    Dim rng1 As Range
    Dim rng2 As Range
    
    Dim tbl As Table
    Dim para As Paragraph
    Dim para2 As Paragraph
    Dim p As Integer
    Set rng = ActiveDocument.Range
    'replace space(s) after blue colon with tab characters
    With rng.Find
        .Font.TextColor = 12611584
        .Text = ":^s^s" 'colon with two non-breaking spaces
        .Replacement.Text = ":^t"
        .Execute Replace:=wdReplaceAll
        .Text = ":^s" 'colon with one non-breaking spaces
        .Execute Replace:=wdReplaceAll
    End With
    
    'recolour paragraph marks to be replaced with manual line feed characters
    For Each para In ActiveDocument.Range.Paragraphs
        If para.Range.Characters.First.Font.TextColor = -16777216 Then 'automatic colour'
            Set rng = para.Range
            rng.Collapse wdCollapseStart
            rng.MoveStart wdCharacter, -1 'paragraph mark of previous paragraph
            'Set para2 = rng.Paragraphs.First
            If rng.Font.TextColor = 12611584 Then
                rng.Font.TextColor = RGB(0, 255, 0) 'green (first line in cell)
            Else
                rng.Font.TextColor = RGB(255, 0, 0) 'red
            End If
        End If
    Next para
    
    Set rng = ActiveDocument.Range
     'change paragraph marks to immediate  newlines
    With rng.Find
        .Font.TextColor = RGB(0, 255, 0) 'green (first line in cell)
        .Text = "^p"
        .Replacement.Text = "^l" 'unique string that will not prompt a new row in the ConvertToTable method
        .Replacement.Font.TextColor = -16777216
        .Execute Replace:=wdReplaceAll
    End With
    
   'change paragraph marks to potential newlines
    With rng.Find
        .Font.TextColor = RGB(255, 0, 0) 'red
        .Text = "^p"
        .Replacement.Text = "@@@" 'pilot string that will not prompt a new row in the ConvertToTable method
        .Replacement.Font.TextColor = -16777216
        .Execute Replace:=wdReplaceAll
    End With
    
    'create table and change pilot string to actual newline
    Set tbl = ActiveDocument.Range.ConvertToTable(vbTab, , 2)
    With tbl.Range.Find
        .Text = "@@@"
        .Replacement.Text = "^l" 'newline
        .Execute Replace:=wdReplaceAll
    End With
        
End Sub

Open in new window

0
benja123Author Commented:
Thanks Graham, The block of text starts with 'command' and ends 'help'. The blue text is constant but the results (non blue text)  will change each time. The block of text is always followed by another table.

The 'example' and 'note' results have been placed underneath (annoyingly) but would also need to move into column 2. Column one would have the blue text and column two the results.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VB Script

From novice to tech pro — start learning today.