Moving a Horizontal Page Break

[Davis Henderson]

I am attempting to move certain horizontal page breaks up or down a row. If the page break is above one of the grey filled lines, it needs to move up a row (ex. grey line on row 70, page break needs to be before row 69); and if there is a page break is below a grey line, the page break needs to move down a row. Attached is an example file with the macro I have been working on included. Thanks for the help!

 

[Chihiro]

Something like below?

Option Explicit
Sub changePageBreaks()

Dim hBrk As HPageBreak
Dim nRow As Long
For Each hBrk In ActiveSheet.HPageBreaks
    If Cells(hBrk.Location.Row, 1).Interior.ColorIndex <> 15 Then
        nRow = hBrk.Location.Row - 1
        hBrk.Delete
        ActiveSheet.HPageBreaks.Add Before:=Rows(nRow)
    End If
Next

End Sub

 

[Davis Henderson]

Thanks Chihiro, it works great for creating the new page break, but is not deleting the previous pagebreak.

 

[Chihiro]

Hmm? Works fine on my end.

hBrk.Delete will delete current page break if it's not above grey row.

In your sample file, it will delete page break at top of row 93, and add one to top of row 92.

 

[Davis Henderson]

I found the issue. I was changing the pagebreak to move down a row causing the previous page break to remain. I changed it back to your way and it works great. Thanks so much Chihiro!!

 

[Davis Henderson]

Hmm? Works fine on my end.

hBrk.Delete will delete current page break if it's not above grey row.

In your sample file, it will delete page break at top of row 93, and add one to top of row 92.

I had to change the for each to a for loop in order for it to move through the rest of the sheet. However, while the code below works for the example sheet, when moving it to another workbook, the for I loop is stuck on the first page break. Do you see anything in my code that could be causing this?

Option Explicit
Sub changePageBreaks()

Dim counter As Integer
Dim hA
Dim sheetNumber As Integer
Dim I As Integer
Dim n As Long
Dim LineNumber As Long
Dim rng As Range
Dim aRow As Long
Dim bRow As Long
   
    sheetNumber = ActiveWorkbook.Sheets.Count
    For counter = 1 To sheetNumber
    Sheets(counter).Activate
        With ActiveSheet
            If .HPageBreaks.Count > 0 Then
                ReDim hA(0 To .HPageBreaks.Count)
                Debug.Print ActiveSheet.HPageBreaks.Count
                hA(0) = 1
                For I = 1 To UBound(hA)
                hA(I) = .HPageBreaks(I).Location.Row
                Set rng = .HPageBreaks(I).Location
                Debug.Print rng.Address
                LineNumber = rng.Row
                Debug.Print LineNumber
                If Cells(.HPageBreaks(I).Location.Row).Interior.ColorIndex <> 15 Then
                    aRow = .HPageBreaks(I).Location.Row - 1
                    .HPageBreaks(I).Delete
                    ActiveSheet.HPageBreaks.Add Before:=Rows(aRow)
                ElseIf Cells(.HPageBreaks(I).Location.Row, 1).Interior.ColorIndex <> 15 Then
                    bRow = .HPageBreaks(I).Location.Row - 2
                    .HPageBreaks(I).Delete
                    ActiveSheet.HPageBreaks.Add Before:=Rows(bRow)
                End If
                Next I

            Else
                ReDim hA(0 To 0)
                hA(0) = 0
            End If
           
        End With
    Next counter
End Sub

 

[Chihiro]

Syntax is off at this line.

If Cells(.HPageBreaks(I).Location.Row).Interior.ColorIndex <> 15 Then

There may be more...

Upload sample workbook which accurately represent your actual workbook structure and data type (with multiple sheets). It's far easier for me to trouble shoot with it.

 

[Davis Henderson]

Option Explicit
Sub changePageBreaks()

Dim counter As Integer
Dim hA
Dim sheetNumber As Integer
Dim I As Integer
Dim n As Long
Dim LineNumber As Long
Dim rng As Range
Dim aRow As Long
Dim bRow As Long
   
    sheetNumber = ActiveWorkbook.Sheets.Count
    For counter = 1 To sheetNumber
    Sheets(counter).Activate
        With ActiveSheet
            If .HPageBreaks.Count > 0 Then
                ReDim hA(0 To .HPageBreaks.Count)
                Debug.Print ActiveSheet.HPageBreaks.Count
                hA(0) = 1
                For I = 1 To UBound(hA)
                hA(I) = .HPageBreaks(I).Location.Row
                Set rng = .HPageBreaks(I).Location
                Debug.Print rng.Address
                LineNumber = rng.Row
                Debug.Print LineNumber
                If Cells(.HPageBreaks(I).Location.Row).Interior.ColorIndex <> 15 Then
                    aRow = .HPageBreaks(I).Location.Row - 1
                    .HPageBreaks(I).Delete
                    ActiveSheet.HPageBreaks.Add Before:=Rows(aRow)
                ElseIf Cells(.HPageBreaks(I).Location.Row, 1).Interior.ColorIndex <> 15 Then
                    bRow = .HPageBreaks(I).Location.Row - 2
                    .HPageBreaks(I).Delete
                    ActiveSheet.HPageBreaks.Add Before:=Rows(bRow)
                End If
                Next I
    
            Else
                ReDim hA(0 To 0)
                hA(0) = 0
            End If
           
        End With
    Next counter
End Sub

 

[Davis Henderson]

Chihiro, I am struggling to make the file small enough.

 

[Davis Henderson]

Hi Chihiro, I figured out the issue. The workbook had a number for height in scale to fit, instead of automatic. Thanks for the help!