Move each paragraph in table to individual cells and keep styles 1

cheriberi · May 28, 2003

Is it possible to create a macro in Word that will take a selected table and move each paragraph in the table to it's own row (within it's original column) without changing the style of each paragraph?

Each paragraph would keep it's original style, even if bulleted or numbered? Any help would be greatly appreciated!!

TonyJollans · Jun 2, 2003

Hi cheriberi,

Not sure of everything you want but as no-one else has come forward, I'll have a go. The following should take each paragraph from a cell into a newly added cell below. You will have to provide your own reference to the original cell and you may want to leave the first paragraph in the original cell, I don't know. This should copy all formatting but exactly what happens to the numbers in numbered lists which you split up will depend a bit on how you have them defined. Anyway, this should at least give you a starting point:

Code:

Dim tjTable As Table
Dim tjCell As Cell
Dim tjPara As Paragraph
Dim intRow As Integer, intCol As Integer

Set tjTable = ActiveDocument.Tables(1)

Code:

' Reference your own table here

Code:

intRow = 3: intCol = 1

Code:

' Identify your own row and column

Code:

Set tjCell = tjTable.Cell(intRow, intCol)

tjCell.Select
Selection.InsertRowsBelow tjCell.Range.Paragraphs.Count

For Each tjPara In tjCell.Range.Paragraphs
    intRow = intRow + 1
    tjTable.Cell(intRow, intCol).Range.FormattedText = tjPara.Range.FormattedText
    tjPara.Range.Delete
Next

Enjoy,
Tony

cheriberi · Jun 3, 2003

Hi Tony,

I really appreciate your help with this. I tried your code and got an error at the following:

Code:

Selection.InsertRowsBelow tjCell.Range.Paragraphs.Count

I want to make whatever table the cursor is in the selected table and I do want to leave the first paragraph in the original cell.

TonyJollans · Jun 3, 2003

Hi cheriberi,

When you get the error, are you in a cell which has any text in it? If not it might be trying to insert zero rows and not be happy about it. I can't think what else might be the problem at the moment.

Anyway, I have made some changes to the code I posted to (a) avoid the possible error above, (b) leave the first paragraph behind, and (c) work with the cell with the cursor in, BUT ..

.. I have hit a problem in testing it (to do with selecting the last paragraph) and don't want to post bad code. I have to stop shortly and will probably not be able to come back until tomorrow. Sorry for the delay but I will post again.

Enjoy,
Tony

TonyJollans · Jun 4, 2003

Hi cheriberi,

This has been interesting. It’s quite hard to express succinctly but some formatting is carried in paragraphs and so paragraph marks have to be included in the moved data. Line throws are inherent in paragraph marks so the newly created cells all appear to have an extra line at the end. I don’t know what you might want to do about this so have left it as it comes.

Now for the problem I had last night. The final “paragraph” in a cell isn’t ended by a paragraph mark, rather by a “cell mark” (I have no idea of the correct terminology), and if this mark is included in a selection (or, within a macro, a range being worked on) then the whole cell is considered to be the selection. The only way I have found to identify the situation in code is by selecting the ‘paragraph’ and then checking the number of paragraphs in the selection; this seems bizarre to me and there must be a better way and someone out there must know it. The problem it causes is in working with the last paragraph and I have, rather clumsily, got over it by adding an empty paragraph at the end of the cell before I do anything else, and deleting it after I have finished; it seems to work.

I have not exhaustively tested this but I think it’s fairly robust. I hope you can get it to run and then, at least, we can see if it comes close to what you want.

Code:

 Sub SplitCell()

Dim tjTable As Table
Dim tjCell As Cell
Dim tjPara As Paragraph
Dim intRow As Integer, intCol As Integer

Dim FirstPara As Boolean
FirstPara = True

Code:

' If cursor is within a table cell, grab details of it

Code:

If Selection.Information(wdWithInTable) Then
    Set tjTable = Selection.Tables(1)
    Set tjCell = Selection.Cells(1)
    intRow = tjCell.RowIndex
    intCol = tjCell.ColumnIndex
Else
    MsgBox &quot;Please place the cursor in the Cell to split and try again&quot;
    Exit Sub
End If

Code:

' If there are multiple paragraphs add needed number of rows

Code:

If tjCell.Range.Paragraphs.Count < 2 Then
    MsgBox &quot;The current Cell does not contain multiple paragraphs&quot;
Else
    Selection.InsertRowsBelow tjCell.Range.Paragraphs.Count - 1
End If

Code:

' Add empty paragraph at end of cell - see notes

Code:

tjCell.Range.InsertParagraphAfter

Code:

'  Loop through all paragraphs in cell

Code:

For Each tjPara In tjCell.Range.Paragraphs
    
    If FirstPara Then

Code:

' First paragraph

Code:

        FirstPara = False

Code:

' only happens once

Code:

    Else
         
        intRow = intRow + 1

Code:

' Aim at next blank row

Code:

        tjPara.Range.Select

Code:

' Select paragraph

Code:

' Check if at end. See notes for explanation of this.

Code:

        If Selection.Paragraphs.Count > 1 Then

Code:

' Remove empty paragraph added at start

Code:

            Selection.MoveEnd unit:=wdCharacter, Count:=-1
            Selection.Collapse direction:=wdCollapseEnd
            Selection.TypeBackspace
            
        Else

Code:

' Copy paragraph, format and all, and then delete it

Code:

            tjTable.Cell(intRow, intCol).Range.FormattedText _
                    = Selection.FormattedText
            tjPara.Range.Delete
            
        End If
        
    End If
    
Next

End Sub

Enjoy.
Tony

cheriberi · Jun 4, 2003

Hi Tony!

I tried your code, but got a Type Mismatch error on the line:

Code:

Set tjTable = Selection.Tables(1)

The macro stopped on "tjTable" in this line.

Cheryl

TonyJollans · Jun 4, 2003

Hi Cheryl,

Difficult when I don't have the problem. It means that tjTable is, for some reason, the wrong type.

Possibly your references are different from mine. Check Tools > References and make sure you have the Word Library above most everything else.

Next, try dimming it as Object or Variant or explicitly as a Word Table

Code:

Dim tjTable as Object

Code:

or

Code:

Dim tjTable

Code:

or

Code:

Dim tjTable as Word.Table

Least likely is that Selection.Tables(1) isn't what I think, but it works fine for me in both 97 and 2K. What version of Word are you using?

If none of tat works, I'll have to scratch my head a bit more.

Enjoy,
Tony

cheriberi · Jun 4, 2003

Hi Tony,

I get the same error with the first and third option. With the second option, the error moves to the ".Tables" later in the line of code.

I checked my references, the first two are:

Visual Basic for Applications
Microsoft Word 8.0 Object Library

I am using Word 97.

Thanks,

Cheryl

TonyJollans · Jun 4, 2003

Hi Cheryl,

I'm baffled at the moment. I just tried the whole thing in 97 and it wouldn't compile because of .InsertRowsBelow - the error you got yesterday, so I'm looking at a way of doing that differently.

Meanwhile, provided it's not sensitive, if you'd like to copy the routine into your document and send me a copy at Tony@Jollans.com I will try running exactly what you are running and see if I get the same errors. I don't know what else to suggest at the moment.

Enjoy,
Tony

cheriberi · Jun 4, 2003

Hi Tony,

I tried the file you sent me and it worked! Would it be possible to set it up so that it goes to the first column, then the second, etc. until it does the whole table?

You are great!! Thanks!!

Cheryl

TonyJollans · Jun 5, 2003

Hi Cheryl,

Thanks for sending me the document; I never would have cracked it without seeing it. The reason your code wouldn’t compile was due to it being full of unprintable characters. I don’t know how you copied it from the post but I found that when I copied and pasted into Word I got the coloured text and a lot of garbage just as you had; when I then copied this from the document into the VB editor I got the same problems you had. However, if I copied direct from the post into the VB editor all was well – just the text was pasted.

Now, in Word 97 there doesn’t seem to be any way to add rows to a table after the current row so I have had to do a bit of messing to make it work for you. I have also fixed a slight omission I had made and have sent you what should be a working copy.

(it is now another day) …

Since starting to write this I have seen your last post and have changed the code to do as you ask, along with a couple of minor corrections. The full code is posted below for anyone who wants it and I have also put another copy in the mail for you.

Code:

Sub SplitCell()

Dim tjTable As Table
Dim tjCell As Cell
Dim tjPara As Paragraph
Dim intRow As Integer, intCol As Integer

Dim tjCell2 As Cell
Dim intParas As Integer

Dim FirstPara As Boolean

Code:

' If cursor is within a table cell, grab details of it

Code:

If Selection.Information(wdWithInTable) Then
    Set tjTable = Selection.Tables(1)
    Set tjCell = Selection.Cells(1)
Else
    MsgBox &quot;Please place the cursor in the Cell to split and try again&quot;
    Exit Sub
End If

Code:

' Find maximum number of paragraphs in any one cell in row

Code:

intParas = 0

For Each tjCell2 In tjCell.Row.Cells
    
    If tjCell2.Range.Paragraphs.Count > intParas Then
        intParas = tjCell2.Range.Paragraphs.Count
    End If

Next

Code:

' If there are multiple paragraphs add needed number of rows

Code:

If intParas < 2 Then
    MsgBox &quot;There are no cells with multiple paragraphs in the selected row&quot;
    Exit Sub
Else
    
    Application.ScreenUpdating = False

Code:

' 97 Code - Select last cell in row

Code:

    tjTable.Cell(tjCell.RowIndex, tjTable.Columns.Count).Select

Code:

' 97 Code - Moving forward a cell creates a row if need be so ...
    ' ... slightly different code if on last row of table

Code:

    If tjCell.RowIndex = tjTable.Rows.Count Then
        Selection.MoveRight Unit:=wdCell, Count:=1
        If intParas > 2 Then Selection.InsertRows intParas - 2
    Else
        Selection.MoveRight Unit:=wdCell, Count:=1
        Selection.InsertRows intParas - 1
    End If

Code:

'    2K Code (removed) is somewhat simpler
'    Selection.InsertRowsBelow tjCell.Range.Paragraphs.Count - 1

Code:

End If

Code:

' Loop through each cell in row with multiple paragraphs

Code:

For Each tjCell2 In tjCell.Row.Cells
    If tjCell2.Range.Paragraphs.Count > 1 Then
    
        intRow = tjCell2.RowIndex
        intCol = tjCell2.ColumnIndex
        FirstPara = True

Code:

' Add empty paragraph at end of cell - see notes

Code:

        tjCell2.Range.InsertParagraphAfter

Code:

'  Loop through all paragraphs in cell

Code:

        For Each tjPara In tjCell2.Range.Paragraphs
            
            If FirstPara Then

Code:

' First paragraph

Code:

                FirstPara = False

Code:

' only happens once

Code:

            Else
                 
                intRow = intRow + 1

Code:

' Aim at next blank row

Code:

                tjPara.Range.Select

Code:

' Select paragraph

Code:

' Check if at end. See notes for explanation of this.

Code:

                If Selection.Paragraphs.Count > 1 Then

Code:

' Remove empty paragraph added at start

Code:

                    Selection.MoveEnd Unit:=wdCharacter, Count:=-1
                    Selection.Collapse direction:=wdCollapseEnd
                    Selection.TypeBackspace
                    
                Else

Code:

' Copy paragraph, format and all, and then delete it

Code:

                    tjTable.Cell(intRow, intCol).Range.FormattedText _
                            = Selection.FormattedText
                    tjPara.Range.Delete

Code:

' Now clear empty para from target cell

Code:

                    tjTable.Cell(intRow, intCol).Range.Select
                    
                    If Selection.Paragraphs.Count > 1 Then
                    
                        Selection.MoveEnd Unit:=wdCharacter, Count:=-1
                        Selection.Collapse direction:=wdCollapseEnd
                        Selection.TypeBackspace
                        
                    End If
                
                End If
                
            End If
            
        Next
        
    End If
Next

Application.ScreenUpdating = True
    
End Sub

Enjoy,
Tony

cheriberi · Jun 5, 2003

WOW!!

This is fantastic! It works beautifully! I can't thank you enough, Tony!

I'm so glad I found this forum! I'll keep an eye out in case you make any additional changes! You're the best!

Cheryl

cheriberi · Jun 6, 2003

Hi Tony,

One last question. How can I alter the macro to make it run for the entire table the cursor is in, not just the row it's in?

Thanks!

Cheryl

TonyJollans · Jun 6, 2003

Hi Cheryl,

Basically what you need to do is put the whole thing in a big loop - starting from the bottom of the table and working up in order to avoid re-processing newly created rows which, by definition, don't contain multiple paragraphs.

Firstly add a new variable to use for loop control:

Code:

Dim intRow2 as Integer

Next (not absolutely essential), change the first block of code to (a) comment out the setting of variable tjCell and (b) change the error message to make more sense:

Code:

If Selection.Information(wdWithInTable) Then
    Set tjTable = Selection.Tables(1)

Code:

'    Set tjCell = Selection.Cells(1)

Code:

Else
    MsgBox &quot;Please place the cursor in the

Code:

Table

Code:

 to split and try again&quot;
    Exit Sub
End If

Thirdly add the start of the new loop immediately after the above and include as its first statement one to replace the one commented out above as this now needs doing for each row:

Code:

For intRow2 = tjTable.Rows.Count To 1 Step -1

    Set tjCell = tjTable.Cell(intRow2, 1)

And, of course, the end of the loop

Code:

Next

needs to go right at the end, just before the Application.ScreenUpdating = True statement

Inside the loop there are two things to do - firstly remove the error message that says there is nothjing to do in this row:

Code:

If intParas < 2 Then

Code:

'    MsgBox &quot;There are no cells with multiple paragraphs in the selected row&quot;
'    Exit Sub

Code:

Else

and lastly (again, not essential but better for performance) move the End If that corresponds to the above If right to the end, just before the "Next" end of loop added above.

That, along with a bit of tidying up of indentation to make it easier to see the logic, should do the trick. Hope it all makes sense.

Enjoy,
Tony

cheriberi · Jun 6, 2003

Hi Tony,

The changes for updating an entire table worked great! Thank you!!

The only cleanup I see is that some cells end up with an empty paragraph at the end. If I delete the last paragraph mark at the end of the text, the style may change, BUT if I just backspace, the extra paragraph is gone and the style is not affected. Is it possible to check for that by macro?

Thanks again,

Cheryl

TonyJollans · Jun 6, 2003

Hi Cheryl,

Because of Word's behaviour when a selection includes the end of a cell it's a bit awkward. It's what I tried to do (and obviously haven't got quite right) with this bit of code ..

Code:

Selection.MoveEnd Unit:=wdCharacter, Count:=-1Selection.Collapse direction:=wdCollapseEnd
Selection.TypeBackspace

I will try and tweak it over the weekend but it's worth just having a play with it and seeing what happens.

Enjoy,
Tony

cheriberi · Jun 10, 2003

Hi Tony!

Were you able to resolve the extra paragraph mark at the end?

TonyJollans · Jul 2, 2003

Hi Cheryl,

On re-reading your post, I think I may not have been fully understanding what you have. There are two possible situations I can see; the first is where you have a paragraph mark in the cell (as you describe) and the second is where you have some styling but no paragraph mark.

The only way I can see for the first case to arise is if an empty paragraph is copied from one of the original cells. The second case is more interesting and the problem is not in doing it so much as knowing what is wanted.

When you insert a table in Word, all the cells inherit the style at the insertion point, When you add a new row to a table above an existing row each cell inherits the style from the first paragraph in the cell immediately below. When you add a new row to a table below an existing row (this is not normally an option in Word 97 but happens when you tab out of the last cell in the last row of a table) each cell inherits the style from the last paragraph in the cell immediately above. Unless you explicitly change them, the cells will retain whatever style they have inherited.

For the benefit of readers who do not have your test data, you have a table with a few empty columns with a style of “Table Data” and a single multi-paragraph column in the middle with a style of “Table Bullet”. These are your own styles, they don’t come with Word.

When a new row is added to your table each cell inherits a style according to the rules above and this sometimes gives you a cell with a bullet in it. Manually you can remove the bullet with a few keystrokes but this does not change the style - it is still “Table Bullet” but now the paragraph does not have bullets so it gives the appearance of being empty and unstyled.

I have amended my code so that, hopefully, it removes all the obvious formatting (bullets and numbers) from empty cells it creates, and also removes any empty row at the end it may have created. I’m not sure this is the complete solution to your problem and it may appear to work at the moment only for some unforeseen condition to arise later. I have e-mailed you a complete version and, for others, the changes I have made are:

1. Code which inserts rows which used to be:

Code:

If tjCell.RowIndex = tjTable.Rows.Count Then
        Selection.MoveRight Unit:=wdCell, Count:=1
        If intParas > 2 Then Selection.InsertRows intParas - 2
    Else
        Selection.MoveRight Unit:=wdCell, Count:=1
        Selection.InsertRows intParas - 1
    End If

Now reads

Code:

' Moving forward a cell creates a row if on last row
    ' If not on last row, do it explicitly after tabbing forward

Code:

    If intRow2 < tjTable.Rows.Count Then
        Selection.MoveRight Unit:=wdCell, Count:=1
        Selection.InsertRows
    Else
        Selection.MoveRight Unit:=wdCell, Count:=1
    End If

Code:

' Clear bullets and numbers from all inserted cells

Code:

    For Each tjCell2 In tjTable.Rows(intRow2 + 1).Cells
        tjCell2.Range.ListFormat.RemoveNumbers NumberType:=wdNumberParagraph
    Next

Code:

' Insert extra rows (if needed) above previous inserted one

Code:

    If intParas > 2 Then Selection.InsertRows intParas – 2

2. Extra code added right at the end of the For intRow2 .. Next Loop

Code:

EmptyRow = True

Code:

 ' (Dimmed as Boolean at start)

Code:

    For Each tjCell2 In tjTable.Rows(intRow2 + intParas - 1).Cells
 
        If tjCell2.Range.Text <> vbCr & Chr(7) Then
            EmptyRow = False
            Exit For
        End If
    
    Next
    
    If EmptyRow Then tjTable.Rows(intRow2 + intParas - 1).Delete

Enjoy,
Tony

Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Move each paragraph in table to individual cells and keep styles 1

Technical User

Programmer

Technical User

Programmer

Programmer

Technical User

Programmer

Technical User

Programmer

Technical User

Programmer

Technical User

Technical User

Programmer

Technical User

Programmer

Technical User

Programmer

Similar threads

Log in

Part and Inventory Search

Sponsor