Hi
I'm trying to insert a page break after a certain number (26) of
cells, with length >=21, is exceeded
I've grabbed snippets of code from here and there but can't get it
to
work.
Any help would be appreciated

Thanks
Ritchi


Sub InsertPageBreak()
'insert a page break after the count of cells in column 1 with a
defined length (>=21 by default) is exceeded (26 is the default count
to trigger a page insert)


Application.ScreenUpdating = False
ActiveSheet.Activate


Dim CountOfItems As Long
CountOfItems = 0


Call PageBreaksHorizontalRemove


lr = Cells(Rows.Count, 1).End(xlUp).Row
For i = lr To 6 Step -1
'For i = 6 To lr Step 1
If Len(Cells(i, 1)) >= 21 Then CountOfItems = CountOfItems +
1
If CountOfItems = 26 Then
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
If CountOfItems = 26 Then CountOfItems = 0
Next


Application.ScreenUpdating = True
End Sub


Sub PageBreaksHorizontalRemove()
'Remove all horizontal pagebreaks in active sheet
Dim pb As HPageBreak
Dim lCount As Long


For lCount = ActiveSheet.HPageBreaks.Count To 1 Step -1
Set pb = ActiveSheet.HPageBreaks(lCount)
If pb.Type = xlPageBreakManual Then pb.Delete
Next lCount


End Sub

This code worked for me:

Sub InsertPageBreak()

Dim CountOfItems As Long
Dim LastRow As Long
Dim CurrentRow As Long

CountOfItems = 0
LastRow = Cells(Rows.Count, 1).End(xlUp).Row

For CurrentRow = 2 To LastRow
If Len(Cells(CurrentRow, 1)) >= 21 Then
CountOfItems = CountOfItems + 1
End If
If CountOfItems = 26 Then
ActiveSheet.HPageBreaks.Add before:=Cells(CurrentRow + 1, 1)
CountOfItems = 0
End If
Next CurrentRow

End Sub

"RITCHI" wrote:

> Hi
> I'm trying to insert a page break after a certain number (26) of
> cells, with length >=21, is exceeded
> I've grabbed snippets of code from here and there but can't get it
> to
> work.
> Any help would be appreciated
>
> Thanks
> Ritchi
>
>
> Sub InsertPageBreak()
> 'insert a page break after the count of cells in column 1 with a
> defined length (>=21 by default) is exceeded (26 is the default count
> to trigger a page insert)
>
>
> Application.ScreenUpdating = False
> ActiveSheet.Activate
>
>
> Dim CountOfItems As Long
> CountOfItems = 0
>
>
> Call PageBreaksHorizontalRemove
>
>
> lr = Cells(Rows.Count, 1).End(xlUp).Row
> For i = lr To 6 Step -1
> 'For i = 6 To lr Step 1
> If Len(Cells(i, 1)) >= 21 Then CountOfItems = CountOfItems +
> 1
> If CountOfItems = 26 Then
> ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
> If CountOfItems = 26 Then CountOfItems = 0
> Next
>
>
> Application.ScreenUpdating = True
> End Sub
>
>
> Sub PageBreaksHorizontalRemove()
> 'Remove all horizontal pagebreaks in active sheet
> Dim pb As HPageBreak
> Dim lCount As Long
>
>
> For lCount = ActiveSheet.HPageBreaks.Count To 1 Step -1
> Set pb = ActiveSheet.HPageBreaks(lCount)
> If pb.Type = xlPageBreakManual Then pb.Delete
> Next lCount
>
>
> End Sub
>
>
>