I have a lot of automatically generated reports, each consisting 24 named ranges.
Each named range can’t be broken by a horizontal page break.
My idea was to loop through all named ranges and count the page breaks within.
But I can’t find a way to count page breaks within a named range.
Does anybody know if it is possible at all?
EDIT: Thanks for the suggestions. Hopefully i can find the time to test it before Christmas, otherwise i will come back and answer in January.
Welcome to SO. May simply scan named ranges and then rows of the range for already existing page breaks. But I am afraid it is slow process and may take long time in file with many long named ranges. may please modify it according to your requirement.
Sub test() Dim Rw As Range Dim RngStr As String, Nm As Name For Each Nm In ThisWorkbook.Names RngStr = Nm.Name For Each Rw In Range(RngStr).Rows If Rw.PageBreak <> xlNone Then Debug.Print RngStr & " on " & Range(RngStr).Address(, , , True) & " has a Pagebreak at Row " & Rw.Row End If Next Rw Next Nm End Sub
Carrying on from my comment on @VBasic2008 answer, and blatantly pinching his
Intersect idea I found this works:
Sub CountBreaks() Dim nr As Name Dim Hpb As HPageBreak Dim Vpb As VPageBreak Dim h As Long, v As Long 'May need some method to look at a select number of named ranges. For Each nr In ThisWorkbook.Names For Each Hpb In nr.RefersToRange.Parent.HPageBreaks If Not Intersect(Range(Hpb.Location.Address).EntireRow, _ Range(nr.RefersToRange.Address)) Is Nothing Then h = h + 1 End If Next Hpb For Each Vpb In nr.RefersToRange.Parent.VPageBreaks If Not Intersect(Range(Vpb.Location.Address).EntireColumn, _ Range(nr.RefersToRange.Address)) Is Nothing Then v = v + 1 End If Next Vpb MsgBox nr.Name & " has: " & vbCr & _ h & " horizontal page breaks." & vbCr & _ v & " vertical page breaks.", vbOKOnly + vbInformation h = 0 v = 0 Next nr End Sub
I hope I’ve got the sheet qualifications correct – i.e. I think
Range(Hpb.Location.Address) refers to the correct sheet as well.
.PageSetup.PrintArea = nmAddress in the comment wasn’t needed – was just having problems because my sheet didn’t have any data on it.
I suggest you study first this code for one named range, then you will easily create a loop for all of them.
Sub PageBr() Const cStrName As String = "HPBr" Const cStrRange As String = "B50:B250" Dim nmAddress As String Dim i As Integer Dim j As Integer With Sheet1 ' Define a name (Refers to ThisWorkbook (.Parent)). .Parent.Names.Add cStrName, .Range("B50:B250") nmAddress = .Parent.Names(cStrName).RefersToRange.Address ' Add horizontal pagebreaks. With .HPageBreaks .Add Before:=.Parent.Range("A59") .Add Before:=.Parent.Range("B159") .Add Before:=.Parent.Range("A248") .Add Before:=.Parent.Range("D269") End With ' Range version For i = 1 To .HPageBreaks.Count If Not Intersect(.Range(.HPageBreaks(i).Location.Address) _ .Resize(, .Columns.Count), .Range(nmAddress)) Is Nothing Then j = j + 1 End If Next Debug.Print "The named range '" & cStrName & "' contains " & j _ & " horizontal pagebreaks." ' Row version Dim pbRow As Long Dim nmRow1 As Long Dim nmRow2 As Long nmRow1 = .Range(nmAddress).Row nmRow2 = .Range(nmAddress).Rows.Count + .Range(nmAddress).Row - 1 j = 0 For i = 1 To .HPageBreaks.Count pbRow = .Range(.HPageBreaks(i).Location.Address).Row If pbRow >= nmRow1 And pbRow <= nmRow2 - 1 Then j = j + 1 End If Next Debug.Print "The named range '" & cStrName & "' contains " & j _ & " horizontal pagebreaks." End With End Sub