Consulting

Results 1 to 5 of 5

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

  1. #1

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

    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

  2. #2
    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
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

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

  4. #4
    VBAX Tutor
    Joined
    Jul 2016
    Posts
    252
    Location
    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

  5. #5
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,040
    Location
    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
    Greg

    Visit my website: http://gregmaxey.com

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •