Iterate cells in a table

Hi, this code creates a table in a blank document.
I want to fill the middle-most 5 columns with the numbers 1-5 (in the
for-next loop).

Dim rng As Range
Dim intCount As Integer

Set rng = ActiveDocument.Range
ActiveDocument.Tables.Add rng, 2, 1

Set rng = rng.Tables(1).Rows(1).Range
rng.Cells(1).Split 1, 3

Set rng = rng.Tables(1).Rows(2).Range
rng.Cells(1).Split 1, 2

Set rng = rng.Tables(1).Rows(2).Cells(2).Range
rng.Cells.Split 5, 2

For intCount = 1 To 5
' Fill central column
Next

Any hints would be appreciated,
Graeme.

Doug
Wed Apr 02 20:34:12 PDT 2008

With ActiveDocument.Tables(1)
For intCount = 1 To 5
.Cell(1 + intCount, 2).Range.Text = intCount
Next
End With


--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

"GraemeR" <GraemeR@discussions.microsoft.com> wrote in message
news:D17ED187-2B81-49FB-944E-A53E87A60E01@microsoft.com...
> Hi, this code creates a table in a blank document.
> I want to fill the middle-most 5 columns with the numbers 1-5 (in the
> for-next loop).
>
> Dim rng As Range
> Dim intCount As Integer
>
> Set rng = ActiveDocument.Range
> ActiveDocument.Tables.Add rng, 2, 1
>
> Set rng = rng.Tables(1).Rows(1).Range
> rng.Cells(1).Split 1, 3
>
> Set rng = rng.Tables(1).Rows(2).Range
> rng.Cells(1).Split 1, 2
>
> Set rng = rng.Tables(1).Rows(2).Cells(2).Range
> rng.Cells.Split 5, 2
>
> For intCount = 1 To 5
> ' Fill central column
> Next
>
> Any hints would be appreciated,
> Graeme.

GraemeR
Wed Apr 02 20:51:00 PDT 2008

Thanks Doug, that does indeed work.

I need to establish how to reproduce my error now (much more complex
table)... I'll keep you posted.

Graeme.

GraemeR
Tue Apr 08 20:51:00 PDT 2008

This is the error I was looking to work around:
5991: Cannot access individual rows in this collection because the table has
vertically merged cells.

Again, any help will be appreciated,
Graeme.

This code reproduces the error:

Dim rng As Range
Dim tbl As Table
Dim intCount As Integer

Set rng = ActiveDocument.Range
ActiveDocument.Tables.Add rng, 2, 1

Set tbl = rng.Tables(1)

Set rng = tbl.Rows(1).Range
rng.Cells(1).Split 1, 3

Set rng = tbl.Rows(2).Range
rng.Cells(1).Split 1, 2

Set rng = tbl.Rows(2).Cells(2).Range
rng.Cells.Split 5, 2

For intCount = 1 To 5
tbl.Cell(1 + intCount, 2).Range.Text = intCount
Next

tbl.Rows.Add

Dim rw As Row
Set rw = tbl.Rows(tbl.Rows.Count).Range.Rows(1) ' <== error 5991
rw.Cells.Split 1, 1, True ' Start of new layout for table

Doug
Wed Apr 09 02:25:46 PDT 2008

Assuming that you want to split the first cell in the new row into two
columns, use

Dim rng As Range
Dim tbl As Table
Dim intCount As Integer


Set rng = ActiveDocument.Range
Set tbl = ActiveDocument.Tables.Add(rng, 2, 1)

With tbl
.Cell(1, 1).Split 1, 3
.Cell(2, 1).Split 1, 2
.Cell(2, 2).Split 5, 2
For intCount = 1 To 5
.Cell(1 + intCount, 2).Range.Text = intCount
Next
.Rows.Add
intCount = .Rows.Count
.Cell(intCount, 1).Split 1, 2
End With

You can't split a cell with

Split 1, 1

as the cell already has one row and one column

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

"GraemeR" <GraemeR@discussions.microsoft.com> wrote in message
news:3FD122F1-ED07-42CF-AF7C-ABFB6A62642F@microsoft.com...
> This is the error I was looking to work around:
> 5991: Cannot access individual rows in this collection because the table
> has
> vertically merged cells.
>
> Again, any help will be appreciated,
> Graeme.
>
> This code reproduces the error:
>
> Dim rng As Range
> Dim tbl As Table
> Dim intCount As Integer
>
> Set rng = ActiveDocument.Range
> ActiveDocument.Tables.Add rng, 2, 1
>
> Set tbl = rng.Tables(1)
>
> Set rng = tbl.Rows(1).Range
> rng.Cells(1).Split 1, 3
>
> Set rng = tbl.Rows(2).Range
> rng.Cells(1).Split 1, 2
>
> Set rng = tbl.Rows(2).Cells(2).Range
> rng.Cells.Split 5, 2
>
> For intCount = 1 To 5
> tbl.Cell(1 + intCount, 2).Range.Text = intCount
> Next
>
> tbl.Rows.Add
>
> Dim rw As Row
> Set rw = tbl.Rows(tbl.Rows.Count).Range.Rows(1) ' <== error 5991
> rw.Cells.Split 1, 1, True ' Start of new layout for table

GraemeR
Wed Apr 09 13:13:00 PDT 2008

I want to split the new row into 2 columns.

Using your code as reference

.Rows.Add ' <== creates a new row with 3 columns
intCount = .Rows.Count
.Cell(intCount, 1).Split 1, 2 ' <== splits first cell - row has four
columns

My code

rw.Cells.Split 1, 1, True ' <== want to merge all cells in the row

From a single cell at the bottom of the table I can create the layout.

Restating the question (as the problem's evolved):
How do I add a new row to a table and merges its columns (considering error
5991)?

Thanks, Graeme

Doug
Fri Apr 11 02:26:46 PDT 2008

That's a case where you will need to use the Selection object (normally
to be avoided)

Dim rng As Range
Dim tbl As Table
Dim intCount As Long
Set rng = ActiveDocument.Range
Set tbl = ActiveDocument.Tables.Add(rng, 2, 1)
With tbl
.Cell(1, 1).Split 1, 3
.Cell(2, 1).Split 1, 2
.Cell(2, 2).Split 5, 2
For intCount = 1 To 5
.Cell(1 + intCount, 2).Range.Text = intCount
Next
.Rows.Add
intCount = .Rows.Count
.Cell(intCount, 1).Select
Selection.Extend
Selection.MoveEnd Unit:=wdCell, Count:=3
Selection.Cells.Split 1, 2, True
Selection.Collapse wdCollapseStart
End With

Note that .Split 1, 1 is trying to split a cell into 1 row and 1 column.
One of the other of the arguements must be greater than 1 for a split to
take place.

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

"GraemeR" <GraemeR@discussions.microsoft.com> wrote in message
news:72654FBE-A152-47D3-B8A6-A0867CA530A0@microsoft.com...
>I want to split the new row into 2 columns.
>
> Using your code as reference
>
> .Rows.Add ' <== creates a new row with 3 columns
> intCount = .Rows.Count
> .Cell(intCount, 1).Split 1, 2 ' <== splits first cell - row has
> four
> columns
>
> My code
>
> rw.Cells.Split 1, 1, True ' <== want to merge all cells in the row
>
> From a single cell at the bottom of the table I can create the layout.
>
> Restating the question (as the problem's evolved):
> How do I add a new row to a table and merges its columns (considering
> error
> 5991)?
>
> Thanks, Graeme

neemehta76
Fri Apr 18 13:16:46 PDT 2008

Hi,

I'm trying to split rows. but the challenge for me here is.. I don't
want to split that row where the row has only one cell as it has
heading. I use the following code to split all rows..

Sub sSplitTable()

If Documents.Count = 0 Then
MsgBox ("Documents Not Open")
Exit Sub
End If
ntables = ActiveDocument.Tables.Count
If ntables > 0 Then
i = 1
With ActiveDocument.Tables
Do While .Item(i).Rows.Count
.Item(i).Cell(2, 0).Select
Selection.SplitTable
i = i + 1
If i > ActiveDocument.Tables.Count Then Exit Sub
Loop
End With
Else
MsgBox ("No Table found")
End If

End Sub

Any help on splitting rows where cells are greater than 1?

-Nee

GraemeR
Tue Apr 29 22:11:00 PDT 2008

Thanks Doug, I was using the Selection object early on in development. I
abandoned that line when navigation failed in multiple-paged tables.

The solution I developed (that works 'cause I know how mant sections I want
to create) was to add new rows, placing a bookmark in each before I set about
splitting the second cell/column to many rows and columns. The bookmark is
never lost so I can return to it later.

My code (automating from MS Access):

Public Sub addSectionBRow(ByVal vstrType As String)
On Error GoTo Err_addSectionBRow

Dim bkm As Word.Bookmark
Dim tbl As Word.Table
Dim rw As Word.Row
Dim cel As Word.Cell

Set bkm = mobjDoc.Bookmarks("SectionBHeader") ' Handle to my table
Set tbl = bkm.Range.Tables(1)
Set rw = tbl.Rows.Add
Set cel = tbl.Cell(tbl.Rows.Count, 1)

rw.Height = 5.75
rw.Range.Cells.Split 1, 2, True
rw.Range.Cells(1).Width = mobjWord.CentimetersToPoints(5.26)
rw.Range.Cells(1).Range.Text = vstrType
rw.Range.Cells(2).Width = mobjWord.CentimetersToPoints(19.75)

cel.Range.Bookmarks.Add vstrType

Exit_addSectionBRow:

Exit Sub
Err_addSectionBRow:

If Not (Err.Source Like "*.*") Then Err.Source =
"clsPerformanceReview.addSectionBRow"

Err.Raise Err.Number, Err.Source

End Sub