Excel VBA to insert a page break before the row if the last 3 characters of the column are ":01-CodePudding

I'm a total novice with VBA. The title describes what I'm looking to do. I need a script to sarch a column (in my case, Column A) and if the last 3 characters are ":01" I need a horizontal page break inserted above it. Bonus points if you can make it skip the FIRST instance of ":01" and only insert page breaks on every subsequent appearance of ":01 in the column after that.

I've been accomplshing what I need with a very clunky process, where I insert a row before Row A, then paste this formula into every cell in the column: =IF(RIGHT(B3, 3) = ":01", 1,"")

Then I'll select Special, choose only numbers, and then run this VBA:

Sub AddPgBrk()
    For Each Cell In Selection
        ActiveWindow.ActiveSheet.HPageBreaks.Add _
            Before:=Cell
    Next Cell
End Sub

Then I delete Column A. It DOES work but I'd love to do it all in one step with a single VBA.

I tried this, and it doesn't give me any errors, but it also doesn't do anything:

Sub AddPgBrk()

Last = Cells(Columns.Count, "A").End(xlUp).Column
For i = Last To 1 Step -1
If (Right(Cells(i, "A"), 3)) = ":01" Then
        ActiveWindow.ActiveSheet.HPageBreaks.Add _
        Before:=Cell
End If
Next i

End Sub


Appreciate the look and assistance. Thanks everyone!

CodePudding user response：

I changed a couple of things in your original code, noted below, and added a counter to avoid the first instance.

Sub AddPgBrk()

Dim Last As Long, i As Long, n As Long, j As Long

Last = Cells(Columns.Count, "A").End(xlUp).Row
n = WorksheetFunction.CountIf(Columns(1), "*:01")

For i = Last To 1 Step -1
    If (Right(Cells(i, "A"), 3)) = ":01" Then
        j = j   1
        If j < n Then
            ActiveSheet.HPageBreaks.Add before:=Cells(i, "A")
        End If
    End If
Next i

End Sub

CodePudding user response：

Add Manual Page Breaks

Sub AddPageBreaks()
    
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    
    Dim rg As Range
    Set rg = ws.Range("A2", ws.Cells(ws.Rows.Count, "A").End(xlUp))
    
    ' Remove only all manual horizontal page breaks.
    ws.Cells.PageBreak = xlPageBreakNone ' also 'ws.Rows' or 'ws.Columns'
    ' Remove all manual page breaks (horizontal and vertical).
    'ws.ResetAllPageBreaks
    ' But how to remove only all manual vertical page breaks?
    
    Dim cell As Range
    Dim pbCount As Long
    Dim FirstFound As Boolean
    
    For Each cell In rg.Cells
        If Right(CStr(cell.Value), 3) = ":01" Then
            If FirstFound Then
                ws.HPageBreaks.Add Before:=cell
                'cell.EntireRow.PageBreak = xlPageBreakManual ' much slower
                pbCount = pbCount   1
            Else ' skip the first
                FirstFound = True
            End If
        End If
    Next cell
    
    MsgBox "Manual horizontal page breaks added: " & pbCount & vbLf _
        & "Total horizontal page breaks: " & ws.HPageBreaks.Count, vbInformation
    
    'ws.ExportAsFixedFormat xlTypePDF, "Test.pdf", , True, False, , , True
    
End Sub