Moving HPageBreaks if Splitting Rows with Data

[sdbroyles]

Hello,

I have looked in the forum and googled for code to do what I need with no luck. Hoping for some help. If a hpagebreak falls between 2 rows that contain data anywhere in the rows, move the hpagebreak up 1 line, if the hpagebreak still falls between 2 rows that contain data, move up another row, etc. If the hpagebreak falls between 2 rows not containing data, or 2 rows where only 1 row contains data and the other does not, then do nothing and move on to the next hpagebreak. The first snippit is an example of the hpagebreak not needing to be moved. The 2nd snippit is an example of the hpagebreak needing to be moved up 1 line. The 3rd snippit is an example of the hpagebreak nedding to be moved up 3 lines. Any help would be greatly appreciated.

 

[Domenic]

The following macro assumes that the worksheet for which to adjust the horizontal page breaks is the active sheet . . .

Option Explicit

Sub AdjustHorizontalPageBreaks()

    Dim originalView
    Dim loc As Range
    Dim i As Long
    
    With ActiveWindow
        originalView = .View            'remember active window's view
        .View = xlPageBreakPreview      'change the view to xlPageBreakPreview (needed for subsequent code)
    End With
    
    With ActiveSheet.HPageBreaks
        For i = .Count To 1 Step -1
            Set loc = .Item(i).Location
            Do
                If (Application.CountA(loc.Offset(-1, 0)) = 0) Then
                    Set .Item(i).Location = loc
                    Exit Do
                End If
                Set loc = loc.Offset(-1, 0)
            Loop While (loc.Row > 1)
        Next i
    End With
    
    ActiveWindow.View = originalView    'change back to the original view
    
End Sub

Hope this helps!

 

[sdbroyles]

The following macro assumes that the worksheet for which to adjust the horizontal page breaks is the active sheet . . .

Option Explicit

Sub AdjustHorizontalPageBreaks()

    Dim originalView
    Dim loc As Range
    Dim i As Long
   
    With ActiveWindow
        originalView = .View            'remember active window's view
        .View = xlPageBreakPreview      'change the view to xlPageBreakPreview (needed for subsequent code)
    End With
   
    With ActiveSheet.HPageBreaks
        For i = .Count To 1 Step -1
            Set loc = .Item(i).Location
            Do
                If (Application.CountA(loc.Offset(-1, 0)) = 0) Then
                    Set .Item(i).Location = loc
                    Exit Do
                End If
                Set loc = loc.Offset(-1, 0)
            Loop While (loc.Row > 1)
        Next i
    End With
   
    ActiveWindow.View = originalView    'change back to the original view
   
End Sub

Hope this helps!

Thank you so much for your help. The code is partially working, but not fully. I hope I can explain well enough so you understand what the issue is. The 1st snippit is lines 40/41, which is where the default pagebreak was. Your code changed the dotted line default pagebreak to a manual pagebreak, which was not needed because it didn't need to move. There were several other lines that also didn't nee to move, but did move up 2 lines. You can see what the issue is in the other 3 snippits

 

[Domenic]

Okay, I have amended the macro so that automatic breaks are not replaced with manual breaks when the row above is empty. Also, I added a line that resets all of the page breaks before proceeding to adjust them, in case manual breaks already exist.

Option Explicit

Sub AdjustHorizontalPageBreaks()

    Dim originalView
    Dim loc As Range
    Dim i As Long
    
    With ActiveWindow
        originalView = .View            'remember active window's view
        .View = xlPageBreakPreview      'change the view to xlPageBreakPreview (needed for subsequent code)
    End With
    
    With ActiveSheet
        .ResetAllPageBreaks
        With .HPageBreaks
            For i = .Count To 1 Step -1
                Set loc = .Item(i).Location
                If (Application.CountA(loc.EntireRow.Offset(-1, 0)) > 0) Then
                    Do
                        If (Application.CountA(loc.EntireRow.Offset(-1, 0)) = 0) Then
                            Set .Item(i).Location = loc
                            Exit Do
                        End If
                        Set loc = loc.Offset(-1, 0)
                    Loop While (loc.Row > 1)
                End If
            Next i
        End With
    End With
    
    ActiveWindow.View = originalView    'change back to the original view
    
End Sub

Does this help?

 

[sdbroyles]

Okay, I have amended the macro so that automatic breaks are not replaced with manual breaks when the row above is empty. Also, I added a line that resets all of the page breaks before proceeding to adjust them, in case manual breaks already exist.

Option Explicit

Sub AdjustHorizontalPageBreaks()

    Dim originalView
    Dim loc As Range
    Dim i As Long
   
    With ActiveWindow
        originalView = .View            'remember active window's view
        .View = xlPageBreakPreview      'change the view to xlPageBreakPreview (needed for subsequent code)
    End With
   
    With ActiveSheet
        .ResetAllPageBreaks
        With .HPageBreaks
            For i = .Count To 1 Step -1
                Set loc = .Item(i).Location
                If (Application.CountA(loc.EntireRow.Offset(-1, 0)) > 0) Then
                    Do
                        If (Application.CountA(loc.EntireRow.Offset(-1, 0)) = 0) Then
                            Set .Item(i).Location = loc
                            Exit Do
                        End If
                        Set loc = loc.Offset(-1, 0)
                    Loop While (loc.Row > 1)
                End If
            Next i
        End With
    End With
   
    ActiveWindow.View = originalView    'change back to the original view
   
End Sub

Does this help?

Thank you Domenic. Your revised code added a hpagebreak inbetween lines 11/12 as shown in the 1st image below and did not move any other hpagebreaks on the sheet. The 2nd image is prior to running the macro. There will never be any existing manual page breaks and a pagebreak does not need to be moved if a row above OR below is empty. I don't see an option to upload my file to make things a little easier to understand.

 

[Domenic]

Yes, it would help if you uploaded a sample workbook. You can upload it to your OneDrive, and provide a link to it.

Have one sheet showing the original state with all possible scenarios. And then have another sheet showing the desired result.

Cheers!

 

[sdbroyles]

Thank you Domenic. Attached are links to 2 files, one with unaltered page breaks and one with how it should look after adjusting the page breaks. Please note that this sheet changes on a daily basis and can be anywhere from 1 page in length to approx. 30 pages in length. One of the issues I was having is that when 1 page break is moved, it moves all other page breaks beneath it up the same amount of lines. So, a page break that didn't need to be moved originally, could possibly need to be moved after the page break above it is moved.

https://1drv.ms/x/s!AkJkjvGLGAYDg1fYNnw06yOuiiQb
https://1drv.ms/x/s!AkJkjvGLGAYDg1h3jADe-dRvYsxM

 

[Domenic]

Just wanted to let you know that I have not forgotten about your post.

I have amended the code, but I just need to test it to make sure that everything is okay. I should get a chance to do that this evening. As soon as I do that I will post it.

Cheers!

 

[Domenic]

Okay, I have modified the macro. So now it will loop through each horizontal page break, starting from the first one, and then use the following logic to determine whether a page break should be adjusted...

1. If the cell in Column A contains a number, it does nothing.
2. Otherwise, if the cell in Column A is blank, and there are no numbers greater than or equal to zero within the row, it does nothing.
3. Otherwise, the page break continues to move upwards until it reaches a cell in Column A that contains a number.

Here's the amended macro . . .

Option Explicit

Sub AdjustHorizontalPageBreaks()

    Dim originalView As XlWindowView
    Dim currentPageBreak As hPageBreak
    Dim currentLocation As Range
    Dim pageBreakCount As Long
    Dim previousBlankRow As Long
    Dim i As Long
  
    With ActiveWindow
        originalView = .View            'remember active window's view
        .View = xlPageBreakPreview      'change the view to xlPageBreakPreview (needed for subsequent code)
    End With
  
    pageBreakCount = 1
  
    On Error Resume Next
    Set currentPageBreak = ActiveSheet.HPageBreaks(pageBreakCount)
    If Not currentPageBreak Is Nothing Then
        Do
            Set currentLocation = currentPageBreak.Location
            If Len(currentLocation) > 0 And IsNumeric(currentLocation) Then
                'do nothing
            ElseIf (Len(currentLocation) = 0) And (Application.CountIf(currentLocation.EntireRow, ">=0") = 0) Then
                'do nothing
            Else
                Do
                    Set currentLocation = currentLocation.Offset(-1, 0)
                    If (currentLocation.Row = 1) Then
                        Exit Sub
                    End If
                Loop Until (Len(currentLocation) > 0) And IsNumeric(currentLocation)
                Set currentPageBreak.Location = currentLocation
            End If
            Set currentPageBreak = Nothing
            pageBreakCount = pageBreakCount + 1
            Set currentPageBreak = ActiveSheet.HPageBreaks(pageBreakCount)
        Loop Until currentPageBreak Is Nothing
    End If
    On Error GoTo 0
  
    ActiveWindow.View = originalView    'change back to the original view
  
End Sub

Does this help?

 

[sdbroyles]

Okay, I have modified the macro. So now it will loop through each horizontal page break, starting from the first one, and then use the following logic to determine whether a page break should be adjusted...

1. If the cell in Column A contains a number, it does nothing.
2. Otherwise, if the cell in Column A is blank, and there are no numbers greater than or equal to zero within the row, it does nothing.
3. Otherwise, the page break continues to move upwards until it reaches a cell in Column A that contains a number.

Here's the amended macro . . .

Option Explicit

Sub AdjustHorizontalPageBreaks()

    Dim originalView As XlWindowView
    Dim currentPageBreak As hPageBreak
    Dim currentLocation As Range
    Dim pageBreakCount As Long
    Dim previousBlankRow As Long
    Dim i As Long
 
    With ActiveWindow
        originalView = .View            'remember active window's view
        .View = xlPageBreakPreview      'change the view to xlPageBreakPreview (needed for subsequent code)
    End With
 
    pageBreakCount = 1
 
    On Error Resume Next
    Set currentPageBreak = ActiveSheet.HPageBreaks(pageBreakCount)
    If Not currentPageBreak Is Nothing Then
        Do
            Set currentLocation = currentPageBreak.Location
            If Len(currentLocation) > 0 And IsNumeric(currentLocation) Then
                'do nothing
            ElseIf (Len(currentLocation) = 0) And (Application.CountIf(currentLocation.EntireRow, ">=0") = 0) Then
                'do nothing
            Else
                Do
                    Set currentLocation = currentLocation.Offset(-1, 0)
                    If (currentLocation.Row = 1) Then
                        Exit Sub
                    End If
                Loop Until (Len(currentLocation) > 0) And IsNumeric(currentLocation)
                Set currentPageBreak.Location = currentLocation
            End If
            Set currentPageBreak = Nothing
            pageBreakCount = pageBreakCount + 1
            Set currentPageBreak = ActiveSheet.HPageBreaks(pageBreakCount)
        Loop Until currentPageBreak Is Nothing
    End If
    On Error GoTo 0
 
    ActiveWindow.View = originalView    'change back to the original view
 
End Sub

Does this help?

This worked perfectly!!! Thank you so much for your help Domenic. Looking at your code, it's no wonder I couldn't figure it out, I'm no where near your level of expertise. After adding your code to my macro, it highlighted an issue my macro appaerntly had with setting the print area. Would you be able to tell me why this code is not picking up the last row with data in it? I know it has something to do with the Range because when I changed the Range to ("J2500") it picked up the last row. So, I guess I need to specify a range of columns and row number but haven't had any success yet.

ActiveSheet.PageSetup.PrintArea = "$A$a:$J$" & Range ("A2500").End(xlUp).Row