VBA Page Break Based off Cell Value in Column

[bmkelly]

Hello,

I currently have this code which works no problem but I am wondering if I can somehow get the code to look for the Header (in row 1) that contains "Transaction Date" and then look in the column for *Total* and then create a Page Break below.

Sub PageBreak()

ActiveSheet.ResetAllPageBreaks

 Dim fRng As Range, Faddr As String

    With ActiveSheet.Range("R2:R" & ActiveSheet.Range("R" & Rows.Count).End(xlUp).Row)

        Set fRng = .Cells.Find(What:="*Total*", LookIn:=xlFormulas, _
                               LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)

        If Not fRng Is Nothing Then
            Faddr = fRng.Address
            Do
                If Not fRng Is Nothing Then
                    fRng.Offset(1).PageBreak = xlPageBreakManual
                End If

                Set fRng = .FindNext(fRng)

                If fRng Is Nothing Then
                    Exit Do
                End If

                If fRng.Address = Faddr Then
                    Exit Do
                End If

            Loop
        End If
    End With
End Sub

Thanks!

 

[DanteAmor]

Try this:

Sub PageBreak()
  Dim hdr As Range, f As Range, r As Range
  Dim cell As String
  Set hdr = Rows(1).Find("Transaction Date", , xlValues, xlWhole, , , False)
  If Not hdr Is Nothing Then
    Set r = Columns(hdr.Column)
    Set f = r.Find("Total", , xlValues, xlPart, , , False)
    If Not f Is Nothing Then
      cell = f.Address
      Do
        f.Offset(1).PageBreak = xlPageBreakManual
        Set f = r.FindNext(f)
      Loop While Not f Is Nothing And f.Address <> cell
    End If
  End If
End Sub

 

[bmkelly]

Try this:

Sub PageBreak()
  Dim hdr As Range, f As Range, r As Range
  Dim cell As String
  Set hdr = Rows(1).Find("Transaction Date", , xlValues, xlWhole, , , False)
  If Not hdr Is Nothing Then
    Set r = Columns(hdr.Column)
    Set f = r.Find("Total", , xlValues, xlPart, , , False)
    If Not f Is Nothing Then
      cell = f.Address
      Do
        f.Offset(1).PageBreak = xlPageBreakManual
        Set f = r.FindNext(f)
      Loop While Not f Is Nothing And f.Address <> cell
    End If
  End If
End Sub

Thank you! This worked perfectly.

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.

 

[eq52515]

I'm glad to help you. Thanks for the feedback.

I have a similar problem, I wonder if you could give this a shot?

I have a varied list of stock numbers. After sorting, I would like to insert a page break after each change in stock number.

Thanks in advance.

 

[DanteAmor]

I have a similar problem, I wonder if you could give this a shot?

I have a varied list of stock numbers. After sorting, I would like to insert a page break after each change in stock number.

The problem is similar, you need a page break. But it represents a new code. Create a new thread.