Move down several rows at once (but not to last row)

[jclasley]

Hello all,

I have a bit of code that I'd like some help with! The gist of my project is that I have a table that is several thousand rows long. It requires manual breaking at the last row of each page, so that it becomes several different tables. I have designed some code so that it selects the first cell of the last row on the page (which is indexed in the table), saves the index as an integer which is then used for calculation of rows per page (denoted SPP in my code). Currently, the code skips down a single line at a time, for a count of SPP.

The program runs fine, it just takes quite a bit of time because it moves down a row at a time. Is there any way to consolidate it so that it moves more quickly?


Do While i < pages
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.SelectRow
With Selection.Borders(wdBorderBottom)
.LineStyle = Options.DefaultBorderLineStyle
.LineWidth = Options.DefaultBorderLineWidth
.Color = Options.DefaultBorderColor
End With
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.InsertBreak Type:=wdPageBreak
Selection.Paste
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.MoveDown Unit:=wdLine, Count:=(SPP)
i = i + 1
Loop

[gmayor]

The following adopts a different approach. As you have not defined SPP in your macro, I have substituted a fixed value for testing. It takes four to five seconds to process a 1000 row table.


Sub Macro1()Dim oTable As Table
Dim oRow As Row
Dim i As Integer
Const SPP As Integer = 46
i = 1
Do
Set oTable = ActiveDocument.Tables(i)
On Error GoTo err_Handler 'run out of rows
Set oRow = oTable.Rows(SPP)
oTable.Split BeforeRow:=oRow
i = i + 1
Loop
lbl_Exit:
Set oTable = Nothing
Set oRow = Nothing
MsgBox "Complete"
Exit Sub
err_Handler:
Err.Clear
GoTo lbl_Exit
End Sub

[jclasley]

Hey Graham,

Thank you for your reply. I’ll give that a shot. I came up with a workaround to make-up for my shortcomings in VBA proficiency. I suppose I should get better at object manipulation.

[Kilroy]

This kind of works.....


Sub SplitTableEndOfPage()
Dim n As Integer
Dim k As Integer
Dim i As Integer
Dim tblStartPage As Long
Dim oTable As Table
Dim oTableRange As Range
Dim oRow As Row
Dim firstrow As Range
n = ActiveDocument.Tables.Count
k = 0
Set firstrow = ActiveDocument.Tables(1).Rows(1).Range
firstrow.Copy

For i = 1 To n
Set oTable = ActiveDocument.Tables(i + k)
If (oTable.Rows.first.Range.Information(3)) <> (oTable.Rows.Last.Range.Information(3)) Then
Set oTableRange = oTable.Range
oTableRange.Collapse 1
tblStartPage = oTableRange.Information(1)
For Each oRow In oTable.Rows
With oRow.Range
If .Information(3) <> tblStartPage Then
k = k + 1
.PasteAndFormat (11)
oTable.Rows(oRow.Index - 1).Select
Selection.SplitTable
tblStartPage = .Information(3)
.InsertBefore ("Table continued from previous page.")
End If
End With
Next
End If
Next i
End Sub

[gmaxey]

Here is my two cents:


Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oTbl As Table
Dim lngStart As Long, lngPageIndex as Long
Dim oRow As Row
lngStart = 15 'or whatever value gets you close to the last row per page
Do
Set oTbl = ActiveDocument.Tables(ActiveDocument.Tables.Count)
On Error Resume Next
oTbl.Range.Paragraphs.First.Previous.Range.Font.Size = 1
On Error GoTo 0
On Error GoTo Err_Start
Set oRow = oTbl.Rows(lngStart)
lngPageIndex = oRow.Range.Information(wdActiveEndPageNumber)
Do
DoEvents
Set oRow = oRow.Next
If oRow.Range.Information(wdActiveEndPageNumber) = ActiveDocument.Paragraphs.Last.Range.Information(wdActiveEndPageNumber) Then Exit Do
Loop Until oRow.Range.Information(wdActiveEndPageNumber) = lngPageIndex + 1
oTbl.Split BeforeRow:=oRow
DoEvents
Loop
lbl_Exit:
Exit Sub
Err_Start:
Resume lbl_Exit
End Sub

[Kilroy]

This is working good for me. Kind of slow. 1000 rows 2:02


Sub SplitTableEndOfPage()
Dim n As Integer
Dim k As Integer
Dim i As Integer
Dim tblStartPage As Long
Dim oTable As Table
Dim oTableRange As Range
Dim oRow As Row
Dim firstrow As Range
123
n = ActiveDocument.Tables.Count
k = 0
Set firstrow = ActiveDocument.Tables(1).Rows(1).Range
firstrow.Copy
For i = 1 To n
Set oTable = ActiveDocument.Tables(i + k)
If (oTable.Rows.first.Range.Information(3)) <> (oTable.Rows.Last.Range.Information(3)) Then
Set oTableRange = oTable.Range
oTableRange.Collapse 1
tblStartPage = oTableRange.Information(1)
For Each oRow In oTable.Rows
With oRow.Range
If .Information(3) <> tblStartPage Then
k = k + 1
.PasteAndFormat (11)
oTable.Rows(oRow.Index - 1).Select
Selection.SplitTable
tblStartPage = .Information(3)
.InsertBefore ("Table continued from previous page.")
Selection.InsertBreak Type:=wdPageBreak
.InsertBefore ("Table continued on next page.")
End If
End With
Next
End If
Next i
t = ActiveDocument.Tables.Count
If t <> n Then GoTo 123 _
Else: GoTo 321
321
End Sub