How to identify the last page break in a sheet

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,147
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
How can I find the position of the last page break in my sheet? There may be multiple pages and I want to know how to find the position of the first page break below the last row.
 

Some videos you may like

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
20,025
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
This will find each PBreak and list them on Sheet3
VBA Code:
Sub LHPB()
Set ws = Worksheets("Sheet1")
For i = 1 To ws.HPageBreaks.Count
 Worksheets("Sheet3").Cells(i, 1).Value = ws.HPageBreaks(i).Location.Row
MsgBox ws.HPageBreaks(i).Location.Row
Next
End Sub
 

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,147
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
What if I wanted the .top position of just the last page break?
 

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,147
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
What is wrong with my code to put an image below the last page break if it lies across the page break? The variable user stores the name of the image.

I get the error subscript out of range with the following line highlighted
VBA Code:
aaa = Rows(Sheets("CSS_quote_sheet").HPageBreaks(NoPages).Location.Row).Top + 1

VBA Code:
Sub cmdPush(user As String)
Dim a As Double, aa As Double, aaa As Double, DividerBottom As Long
Dim NoPages As Long
'Finds the number of pages
NoPages = ((ActiveSheet.HPageBreaks.Count + 1) * (ActiveSheet.VPageBreaks.Count + 1)) / 2

Application.ScreenUpdating = False
    With Sheets("Sheet2")
        .Shapes(user).Duplicate.Name = "Signature"
        .Shapes("Signature").Cut
    End With
        Sheets("CSS_quote_sheet").Cells(43, 1).PasteSpecial
        Sheets("CSS_quote_sheet").Shapes(Selection.Name).Name = "Signature"
        a = Sheets("CSS_quote_sheet").Cells(LastRow, 1).End(xlUp).Offset(1).Top + 140
        aa = Sheets("CSS_quote_sheet").Shapes("Signature").Height
        aaa = Rows(Sheets("CSS_quote_sheet").HPageBreaks(NoPages).Location.Row).Top + 1
        DividerBottom = Sheets("CSS_quote_sheet").Shapes("Divider").BottomRightCell.Row
    With Sheets("CSS_quote_sheet").Shapes("Signature")
        .Left = ActiveSheet.Range("A1").Left
   
        .Top = IIf(a + aa > aaa, aaa, a)
        .Placement = 1
    End With
Application.ScreenUpdating = True
End Sub
 

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
20,025
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows

ADVERTISEMENT

VBA Code:
Sub LHPB()
Set ws = Worksheets("Sheet1")
n = ws.HPageBreaks.Count
MsgBox ws.HPageBreaks(n).Location.Row - 1
End Sub
 

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
20,025
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
You haven't dimmed OR stated what LastRow is in this code, so it will fail....Also, Is user a valid string(does it exist when you run the code)
AND
I'd avoid using a...aa...aaa as variables...too confusing
VBA Code:
Sub cmdPush(user As String)
Dim a As Double, aa As Double, aaa As Double, DividerBottom As Long
Dim NoPages As Long, ws As Worksheet
Set ws = Sheets("CSS_quote_sheet")
'Finds the number of pages
NoPages = ((ActiveSheet.HPageBreaks.Count + 1) * (ActiveSheet.VPageBreaks.Count + 1)) / 2
Application.ScreenUpdating = False
    With Sheets("Sheet2")
        .Shapes(user).Duplicate.Name = "Signature"
        .Shapes("Signature").Cut
    End With
        ws.Cells(43, 1).PasteSpecial
        ws.Shapes(Selection.Name).Name = "Signature"
        a = ws.Cells(LastRow, 1).End(xlUp).Offset(1).Top + 140
        aa = ws.Shapes("Signature").Height
        aaa = Rows(ws.HPageBreaks(NoPages).Location.Row).Top + 1
        DividerBottom = ws.Shapes("Divider").BottomRightCell.Row
    With ws.Shapes("Signature")
        .Left = ActiveSheet.Range("A1").Left
   
        .Top = IIf(a + aa > aaa, aaa, a)
        .Placement = 1
    End With
Application.ScreenUpdating = True
End Sub
 

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,147
Office Version
  1. 365
  2. 2016
Platform
  1. Windows

ADVERTISEMENT

I am trying to work it out but I can't quite get it. Here is what all my code so far:

VBA Code:
Function LastRow()
'Dim LastRow As Long
    With Sheets("CSS_quote_sheet")
        LastRow = .Range("A:H").Find(What:="*", _
            After:=.Range("A1"), _
            Lookat:=xlPart, _
            LookIn:=xlFormulas, _
            SearchOrder:=xlByRows, _
            SearchDirection:=xlPrevious, _
            MatchCase:=False).Row
    End With
End Function
Sub cmdTraceySig()
    Quoting.Unprotect Password:=ToUnlock
    Dim user As String
        user = "ImgT"
        'Call cmdNoSig
        Call cmdPush(user)
    Quoting.Protect Password:=ToUnlock
End Sub
Sub cmdLynSig()
    Quoting.Unprotect Password:=ToUnlock
    Dim user As String
        user = "ImgL"
        Call cmdNoSig
        Call cmdPush(user)
    Quoting.Protect Password:=ToUnlock
End Sub
Sub cmdGarrettSig()
    Quoting.Unprotect Password:=ToUnlock
    Dim user As String
        user = "ImgG"
        Call cmdNoSig
        Call cmdPush(user)
    Quoting.Protect Password:=ToUnlock
End Sub
Sub cmdJonathanSig()
    Quoting.Unprotect Password:=ToUnlock
    Dim user As String
        user = "ImgJ"
        Call cmdNoSig
        Call cmdPush(user)
    Quoting.Protect Password:=ToUnlock
End Sub

Sub EmptyCellsInA()
    Dim LO As ListObject, n As Long
    Set LO = ActiveSheet.ListObjects("css_quote")
    n = LO.DataBodyRange.Rows.Count - Application.CountA(LO.DataBodyRange.Columns(1))
    MsgBox "There are " & n & " empty table cells in column A"
End Sub

Sub cmdNoSig()
    Dim Pic As Object
    
    For Each Pic In ActiveSheet.Pictures
        If Pic.Name <> "lblActivities" And Pic.Name <> "TextBox3" And Pic.Name <> "lblNotes" And Pic.Name <> "cmdAdd_Nlines" And Pic.Name <> "cmdDeleteRow" And Pic.Name <> "cmdClearNotDates" And _
        Pic.Name <> "cmdDelSelect" And Pic.Name <> "cmdGarrettB" And Pic.Name <> "cmdNoSignature" And Pic.Name <> "cmdSendTCT" And Pic.Name <> "cmdSort" And _
        Pic.Name <> "cmdDeleteQuoteLines" And Pic.Name <> "ImgLogo" And Pic.Name <> "cmdCustom" And Pic.Name <> "chkIncrease" And Pic.Name <> "lblIncrease" And _
        Pic.Name <> "cmdTraceyS" And Pic.Name <> "cmdLynL" And Pic.Name <> "cmdJonathanA" And Pic.Name <> "cmdPrintPdf" And Pic.Name <> "cmdQuoteTips" And _
        Pic.Name <> "Label1" And Pic.Name <> "cmdSendTCTPrint" And Pic.Name <> "textbox4" And Pic.Name <> "lblNotes" And Pic.Name <> "CommandButton1" And Pic.Name <> "cmdUnlock" Then
             ' If Not Intersect(Pic.TopLeftCell, Range("A12:A300")) Is Nothing Then
                  Pic.Delete
              'End If
        End If
    Next Pic
End Sub


And here is cmdPush, which is in the same module.
VBA Code:
Sub cmdPush(user As String)
Dim a As Double, aa As Double, aaa As Double, DividerBottom As Long, ws As Worksheet
Dim n As Long
Set ws = Worksheets("CSS_quote_sheet")
n = ws.HPageBreaks.Count

Application.ScreenUpdating = False
    With Sheets("Sheet2")
        .Shapes(user).Duplicate.Name = "Signature"
        .Shapes("Signature").Cut
    End With
        Sheets("CSS_quote_sheet").Cells(43, 1).PasteSpecial
        Sheets("CSS_quote_sheet").Shapes(Selection.Name).Name = "Signature"
        a = Sheets("CSS_quote_sheet").Cells(LastRow, 1).End(xlUp).Offset(1).Top + 140
        aa = Sheets("CSS_quote_sheet").Shapes("Signature").Height
        aaa = Rows(Sheets("CSS_quote_sheet").HPageBreaks(n).Location.Row).Top + 1
        DividerBottom = Sheets("CSS_quote_sheet").Shapes("Divider").BottomRightCell.Top
    With Sheets("CSS_quote_sheet").Shapes("Signature")
        .Left = ActiveSheet.Range("A1").Left
        .Top = IIf(a + aa > aaa, a, DividerBottom + 140)
        .Placement = 1
    End With
Application.ScreenUpdating = True
End Sub
 

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,147
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
I have tried to change cmdPush but I still can't seem to get it.

VBA Code:
Sub cmdPush(user As String)
Dim TopLastRowPlusSpace As Double, ImageHeight As Double, TopOfLowestPageBreak As Double, DividerBottom As Long, ws As Worksheet
Dim n As Long
Set ws = Worksheets("CSS_quote_sheet")
n = ws.HPageBreaks.Count

Application.ScreenUpdating = False
    With Sheets("Sheet2")
        .Shapes(user).Duplicate.Name = "Signature"
        .Shapes("Signature").Cut
    End With
        Sheets("CSS_quote_sheet").Cells(43, 1).PasteSpecial
        Sheets("CSS_quote_sheet").Shapes(Selection.Name).Name = "Signature"
        TopLastRowPlusSpace = Sheets("CSS_quote_sheet").Cells(LastRow, 1).End(xlUp).Offset(1).Top + 140
        ImageHeight = Sheets("CSS_quote_sheet").Shapes("Signature").Height
        TopOfLowestPageBreak = Rows(Sheets("CSS_quote_sheet").HPageBreaks(n).Location.Row).Top + 1
        DividerBottom = Sheets("CSS_quote_sheet").Shapes("Divider").BottomRightCell.Top
    With Sheets("CSS_quote_sheet").Shapes("Signature")
        .Left = ActiveSheet.Range("A1").Left
        .Top = IIf(TopLastRowPlusSpace + ImageHeight > TopOfLowestPageBreak, TopOfLowestPageBreak + 140, TopLastRowPlusSpace)
        .Placement = 1
    End With
Application.ScreenUpdating = True
End Sub
 

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,147
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
How do I structure the IIF statement to say if the image won't fit on the same page, 140 below the last cell, it goes to the top of the following page?
 

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,147
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
I tried to change my code a little so that the image went to the top of the following page but I get the error, subscript out of range and it highlights this line
VBA Code:
TopOfLowestPageBreak = Rows(Sheets("CSS_quote_sheet").HPageBreaks(n + 1).Location.Row).Top + 1


Here is my whole sub
VBA Code:
Sub cmdPush(user As String)
Dim TopLastRowPlusSpace As Double, ImageHeight As Double, TopOfLowestPageBreak As Double, DividerBottom As Long, ws As Worksheet
Dim n As Long
Set ws = Worksheets("CSS_quote_sheet")
n = ws.HPageBreaks.Count


Application.ScreenUpdating = False
    With Sheets("Sheet2")
        .Shapes(user).Duplicate.Name = "Signature"
        .Shapes("Signature").Cut
    End With
        Sheets("CSS_quote_sheet").Cells(43, 1).PasteSpecial
        Sheets("CSS_quote_sheet").Shapes(Selection.Name).Name = "Signature"
        TopLastRowPlusSpace = Sheets("CSS_quote_sheet").Cells(LastRow, 1).End(xlUp).Offset(1).Top + 140
        ImageHeight = Sheets("CSS_quote_sheet").Shapes("Signature").Height
        TopOfLowestPageBreak = Rows(Sheets("CSS_quote_sheet").HPageBreaks(n + 1).Location.Row).Top + 1
        DividerBottom = Sheets("CSS_quote_sheet").Shapes("Divider").BottomRightCell.Top
    With Sheets("CSS_quote_sheet").Shapes("Signature")
        .Left = ActiveSheet.Range("A1").Left
        .Top = IIf(TopLastRowPlusSpace + ImageHeight > TopOfLowestPageBreak, TopOfLowestPageBreak + 140, TopLastRowPlusSpace)
        .Placement = 1
    End With
Application.ScreenUpdating = True
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,127,009
Messages
5,622,145
Members
415,881
Latest member
tasic89

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top