How to identify the last page break in a sheet

[dpaton05]

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.

 

[Michael M]

This will find each PBreak and list them on Sheet3

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]

What if I wanted the .top position of just the last page break?

 

[dpaton05]

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

aaa = Rows(Sheets("CSS_quote_sheet").HPageBreaks(NoPages).Location.Row).Top + 1

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]

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

 

[Michael M]

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

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]

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

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.

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]

I have tried to change cmdPush but I still can't seem to get it.

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]

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]

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

TopOfLowestPageBreak = Rows(Sheets("CSS_quote_sheet").HPageBreaks(n + 1).Location.Row).Top + 1

Here is my whole sub

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