CODEWITHSUNDEEP
excelvba
Lasse Færch
Lasse Færch

Reputation: 21

VBA Excel: Is it possible to count horizontal page breaks in a named range?

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.

Upvotes: 1

Views: 1324

Answers (3)

Darren Bartrup-Cook
Darren Bartrup-Cook

Reputation: 19782

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.

The .PageSetup.PrintArea = nmAddress in the comment wasn't needed - was just having problems because my sheet didn't have any data on it.

Upvotes: 1

Ahmed AU
Ahmed AU

Reputation: 2777

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

Upvotes: 1

VBasic2008
VBasic2008

Reputation: 54807

PB Hell

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

Upvotes: 0

Related Questions