Solved: Insert column to the right and copy table content

[translator_]

I want to convert text to table (separating text at paragraphs), then copy that table and add its contents as a column on the right. So, at the end, there are two columns with identical content. I have managed to go as far as converting the table...

Sub ConvertTextToATable()
ActiveDocument.Range.Select
Selection.ConvertToTable Separator:=wdWhite, AutoFitBehavior:=wdAutoFitFixed

End Sub

[macropod]

Try:
Sub ConvertTextToATable()
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Format = False
.Text = "([!^13]{1,})(^13)"
.Replacement.Text = "\1^t\1\2"
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With
.ConvertToTable Separator:=wdWhite, AutoFitBehavior:=wdAutoFitFixed
End With
End Sub
Note: Depending on your regional settings, you may need to change {1,} to {1;}.

[translator_]

Thanks (worked with {1;}). However, the result when running your macro was duplicating the content not in new column on the right, but by adding tabs within the single column. (Word 2003). Also, some text was cut off in the duplication process.

[macropod]

My code assumes there are no tables before it is run. Your reply suggests you ran it on a document that already had the table, which is not what your first post suggested was the starting position.

In my testing on a document with no tables, the code generates a two-column table, with the same content in each column. And nothing gest 'cut off'.

[translator_]

Many thanks. I tried with both Word 2003/2010.

Attached the results. File 1 is the text before macro, 2 is after macro is run.

[macropod]

OK, the Find/Replace approach isn't going to work with so much text per cell, so try it this way:
Sub ConvertTextToATable()
Dim Tbl As Table, TblCell As Cell
Set Tbl = ActiveDocument.Range.ConvertToTable(Numcolumns:=2)
With Tbl.Columns(1)
For Each TblCell In .Cells
TblCell.Range.Copy
TblCell.Range.Characters.Last.Next.Paste
Next
End With
End Sub

[translator_]

Yes, Paul. Works perfectly. Your help is much appreciated.

[translator_]

In Word 2010 gives the error:

Cannot access individual columns in this collection because the table has mixed cell widths.

And it does not copy the text on the right column. Also, the grid, does not appear (whereas it appears just fine in Word 2003). I fixed the grid issue with:

Set Tbl = ActiveDocument.Range.ConvertToTable(Numcolumns:=2, _
Format:=wdTableFormatGrid1) but the above error persists.

[macropod]

That suggests you're running the code on a document that already has one or more tables.

[translator_]

Well, I use the same file and there are no tables as far as I can see, works OK in 2003, throws the error in 2010. Attached.

[macropod]

The code I posted works fine for me with your data in both Word 2003 and Word 2010.

[translator_]

Weird. Tried with Word 2007 too. Screenshots attached.

[macropod]

Given that it works fine for me, with both Word 2003 and 2010, I can only conclude there is a fault with your system(s). Try repairing each Office installation.

[translator_]

Yes, it worked ok on a different PC with both Word 2003 and 2010. Repair and diagnostics on usual PC were to no avail.

[macropod]

This is something you'll have to sort out. Clearly there's a difference, perhaps due to addins or configuration.

[translator_]

Thanks. What if I want to use a different delimiter, i.e. not separate text at paragraph, but say the pipe symbol (|).

[macropod]

You could change:
Set Tbl = ActiveDocument.Range.ConvertToTable(Numcolumns:=2)
to:
Set Tbl = ActiveDocument.Range.ConvertToTable(Numcolumns:=2, Separator:="|")