Split rows when row has only one cell

[Neeraj]

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

 

[Helmut Weber]

Hi Neeraj,

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

so you want to split tables at rows,
which are not preceded by a row
that has only one cell, I assume,
if so:

Sub Test4x()
Dim z As Long ' number of one-cell rows
Dim i As Long ' just a counter
Dim oTbl As Table
Dim oRow As Row
Dim oRowx As Row ' previous row
Dim oRowy As Row ' next row
For Each oTbl In ActiveDocument.Tables
For Each oRow In oTbl.Range.Rows
If oRow.Cells.Count = 1 Then
z = z + 1
End If
Next
Next
For i = 1 To z
For Each oTbl In ActiveDocument.Tables
For Each oRow In oTbl.Range.Rows
oRow.Select
If oRow.Cells.Count > 1 Then
Set oRowx = oRow.Previous
Set oRowy = oRow.Next
If Not oRowx Is Nothing Then
If oRow.Previous.Cells.Count > 1 Then
Selection.SplitTable
End If
End If
If Not oRowy Is Nothing Then
If oRowy.Cells.Count = 1 Then
oRowy.Select
Selection.SplitTable
End If
End If
End If
Next
Next
Next
End Sub

which is far from being perfect,
but a workable solution, IMHO,
if there aren't too many tables.




--

Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Vista Small Business, Office XP

 

[Neeraj]

Hi Neeraj,



so you want to split tables at rows,
which are not preceded by a row
that has only one cell, I assume,
if so:

Sub Test4x()
Dim z As Long ' number of one-cell rows
Dim i As Long ' just a counter
Dim oTbl As Table
Dim oRow As Row
Dim oRowx As Row ' previous row
Dim oRowy As Row ' next row
For Each oTbl In ActiveDocument.Tables
   For Each oRow In oTbl.Range.Rows
      If oRow.Cells.Count = 1 Then
         z = z + 1
      End If
   Next
Next
For i = 1 To z
   For Each oTbl In ActiveDocument.Tables
      For Each oRow In oTbl.Range.Rows
         oRow.Select
         If oRow.Cells.Count > 1 Then
         Set oRowx = oRow.Previous
         Set oRowy = oRow.Next
            If Not oRowx Is Nothing Then
               If oRow.Previous.Cells.Count > 1 Then
                  Selection.SplitTable
               End If
            End If
            If Not oRowy Is Nothing Then
               If oRowy.Cells.Count = 1 Then
                  oRowy.Select
                  Selection.SplitTable
               End If
            End If
         End If
      Next
   Next
Next
End Sub

which is far from being perfect,
but a workable solution, IMHO,
if there aren't too many tables.

--

Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Vista Small Business, Office XP

Hi Helmut,

That was wonderful! thank you so much. It worked.
thanks
Nee..