Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 2287
  • Last Modified:

Excel 2003 Repeat header and sub-header after page break

Hello Guru's,

UPDATE:
I've worked on this some and have added the code I found on EE for adding page breaks (see below).  What I'm thinking, and this is more of a question then statement, is that I could add some code in here to do a line count between the word "SUBHEADER".   If the row count is 0, then the first occurrence of the subheader will be deleted.  If a pagebreak was added, then I need to check to see if the row above has a "SUBHEADER" if not, then find the last one and copy it and insert it.

Can you please give me some guidance as to what I need to use?  For example, to check the line before, I think I need to use OFFSET, but I'm clueless what to look for to see if a pagebreak is on the worksheet.

Thanks again.

My users are getting spoiled with your solutions to their requests.  I tell them I couldn't do it without help (a lot of expert help!)  

Today's challenge  is repeating a sub-header after a page break.  The problem is the header is not in a consistent format.  However, I am ok with adding some sort of flag in the sub-header row to trigger VBA code to look for it.  

I have included a workbook with two speadsheets to explain what I'm trying to do.  The first speadsheet is the raw data.  The second spreadsheet is to show what the final printed report should like like.  I'll try to summarize it but I think the spreadsheet tells the story.

I have a report on a spreadsheet that has multiple sub-headers.
Under each sub-header are an undetermined number of rows/records - may be even 0.
Each row has a cell for a comment.  The users like to max out this cell so the cell may have a 1 line comment or a 30 line comment. The row is never a consistent height.

When the page breaks, the new page needs to repeat the sub-header on the 2nd line of the new page.  I know how to do this in Access, but the only way I know how to do this in Excel is to go into page break view and manually insert the sub-header and force a new page break.

Is there a way to do this in VBA?

Thank you again for your expert recommendations and solutions.

Stephanie





From EE and slightly modified: 
 
Sub InsertPageBreaks()
Dim i As Long, rw As Range
 
 For i = ActiveSheet.HPageBreaks.Count To 1 Step -1
    ActiveSheet.HPageBreaks(i).Delete
 Next i
 
For Each rw In ActiveSheet.UsedRange.Rows
    Select Case rw.Cells(1, 1).Text
    Case "SUBHEADER", "b", "d"
        ActiveSheet.HPageBreaks.Add Before:=rw.Cells(1, 1)
    End Select
Next rw
End Sub

Open in new window

Page-break-and-repeat-header-exa.xls
0
Steph_M
Asked:
Steph_M
  • 7
  • 6
6 Solutions
 
StellanRosengrenCommented:
Hi Stephanie,

I modified the code a little. Automatic pagebreaks cannot be deleted, so I delete all manual pagebreaks before adding a pagebreak above each cell where the flag 'SUBHEADER' is found in column 6.

Please advice what else you need. I am not sure I understand completely.

Regards,
Stellan
Sub InsertPageBreaks()
Dim i As Long, rw As Range
Dim pbsH As HPageBreaks
 
 Set pbsH = ActiveSheet.HPageBreaks
 For i = pbsH.Count To 1 Step -1
    If pbsH(i).Type = xlPageBreakManual Then pbsH(i).Delete
 Next i
 
For Each rw In ActiveSheet.UsedRange.Rows
    Select Case rw.Cells(6).Text
    Case "SUBHEADER"
        ActiveSheet.HPageBreaks.Add Before:=rw.Cells(1)
    End Select
Next rw
End Sub

Open in new window

0
 
Steph_MAuthor Commented:
Thank you for taking a look at this.  I think it is a difficult question and am beginning to think that since the report is never over 30 pages, it might be one where the users will need to manually add their page breaks,  We'll give it another try with a (hopefully) better description of what I'm trying to accomplish.  

In MS Access, when I add a group header I can select the following options:
Force New Page - No
Keep Together - Yes
Repeat Section - Yes

So in Excel, I'm trying to make my report keep a group of rows together but if they pagebreak due to page size limitations, I want the group header to duplicate itself on the second row of next page (first row is the report header).

So far, the code I've tried all add a pagebreak but do not take into account the number of rows on the page, for example:

GROUP HEADER WITHOUT ANY RECORDS
PAGEBREAK
GROUPHEADER WITHOUT ANY RECORDS
PAGEBREAK
GROUPHEADER
RECORD ONE
RECORD TWO
PAGEBREAK
GROUPHEADER

All of those should fit on one page but instead the code inserts 4 page breaks.
I did find some code that will add a pagebreak every x# of lines, and even if that is integrated into the other code, it still omits the group header being duplicated and the issue that each row is not the same height.

I would appreciate any suggestion you can offer, even if the suggestion is manually add the pagebreaks and copy and paste the group header where needed!

Thanks again,
Stephanie





0
 
StellanRosengrenCommented:
Hi Stephanie,

I think I understand now. So, the first row is repeated by setting Print titles in Page setup?
And you want to maximize the number of rows per page? So there can be group header further down on a page?
Please clarify these questions and I will figure out a solution. The easiest way is probably to detect automatic pagebreaks and get the location and copy the appropriate group header to that location. You know, the collection HPagebreaks has a property that gives the location. It also has the property type, as you can see in your code.

I'll be back

Regards,
Stellan
0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
Steph_MAuthor Commented:
Exactly!  You summarized that perfectly.

I have one more favor to ask - when you respond can you please include a line that I can put in the immediate window to see what line number the page break is on?  I really do try to learn from the help you provide me by stepping through the code and using the immediate window instead of just cut and pasting the solution :)

Also, you have some time here.  I just learned that I don't need this until 2/24 so we have some time to work with this.

Thanks again-
Stephanie
0
 
StellanRosengrenCommented:
Hi again Stephanie,

I have tried this code on your worksheet and it looks like it is working. The main procedure is 'RepeatSubHeaderOnEachPage()' which is replacing all auto pagebreaks with manual pagebreaks and inserts copied subheaders. They are tagged so that they can be removed if you want to restore the worksheet for some reason. The sub to restore is also included. I have tried to be generous with comments in the code so that you can learn from stepping through.
Please note that the ID column must have empty cells where there is not a subheader, since the method to find the nearest subheader is rC.End(xlUp) which is the VBA method for pressing Ctrl-Up on the keybord.

I have used module level constants so that you can adapt the code easily if you rearrange your worksheet.

Your sample workbook with the new code is also attached.

Regards,
Stellan
Option Explicit
 
Const msID As String = "SUBHEADER"
Const msCOPYID As String = "COPIED SUBHEADER"
Const miIDCOL As Integer = 6
 
'---------------------------------------------------------------------------------------
' Procedure : RepeatSubHeaderOnEachPage
' Author    : Stellan
' Date      : 2009-02-17
' Purpose   : Make sure that subheader is on top of each printed page
'---------------------------------------------------------------------------------------
'
Sub RepeatSubHeaderOnEachPage()
    Dim wkS As Worksheet
    Dim rC As Range
    
    Set wkS = ActiveSheet
    
    'find the first manual pagebreak (always in the first column)
    Set rC = FirstAutoHPageBreak(wkS)
    
    'Loop until no automatic pagebreak is present
    Do While Not rC Is Nothing
        Debug.Print "Auto pagebreak above row: "; rC.Row
        'An automatic pagebreak has been found
        With wkS
            'Check if it happens that the auto pagebreak coincides with a subheader row
            If .Cells(rC.Row, miIDCOL).Value <> msID Then
                rC.EntireRow.Insert 'insert blank row above pagebreak location
                Set rC = rC.Offset(-1, 0) 'change rC to refer to the new row
                'Copy the first subheader that could be found above the new row
                'The method to find the subheader relies on that cells are empty for non-subheaders in the id col
                .Cells(rC.Row, miIDCOL).End(xlUp).EntireRow.Copy Destination:=rC
                'Tag the copied row so that it can be removed
                .Cells(rC.Row, miIDCOL).Value = msCOPYID
            End If
            'Add a manual pagebreak
            .HPageBreaks.Add before:=rC
        End With
        'Find the next auto pagebreak
        Set rC = FirstAutoHPageBreak(wkS)
    Loop
    
End Sub
 
'---------------------------------------------------------------------------------------
' Procedure : FirstAutoHPageBreak
' Author    : Stellan
' Date      : 2009-02-17
' Purpose   : Find the first automatic pagebreak in a worksheet
'---------------------------------------------------------------------------------------
'
Function FirstAutoHPageBreak(wkS As Worksheet) As Range
 
    Dim i As Long
    Dim pbsH As HPageBreaks
    
    Set pbsH = wkS.HPageBreaks
    
    For i = 1 To pbsH.Count
        If pbsH(i).Type = xlPageBreakAutomatic Then
            Set FirstAutoHPageBreak = pbsH(i).Location
            Exit Function
        End If
    Next i
    
End Function
 
'---------------------------------------------------------------------------------------
' Procedure : RestoreWorksheet
' Author    : Stellan
' Date      : 2009-02-17
' Purpose   : Restore activesheet by calling subs to delete copied rows and manual pagebreaks
'---------------------------------------------------------------------------------------
'
Sub RestoreWorksheet()
    Call RemoveCopiedSubheaders
    Call RemoveManualPageBreaks
End Sub
 
'---------------------------------------------------------------------------------------
' Procedure : RemoveManualPageBreaks
' Author    : Stellan
' Date      : 2009-02-17
' Purpose   : Remove all manual pagebreaks on the activesheet
'---------------------------------------------------------------------------------------
'
Sub RemoveManualPageBreaks()
    Dim i As Long
    Dim pbsH As HPageBreaks
 
    Set pbsH = ActiveSheet.HPageBreaks
    For i = pbsH.Count To 1 Step -1
       If pbsH(i).Type = xlPageBreakManual Then pbsH(i).Delete
    Next i
    
End Sub
 
'---------------------------------------------------------------------------------------
' Procedure : RemoveCopiedSubheaders
' Author    : Stellan
' Date      : 2009-02-17
' Purpose   : Delete all rows with copied subheaders in activesheet
'---------------------------------------------------------------------------------------
'
Sub RemoveCopiedSubheaders()
    Dim wkS As Worksheet
    Dim lRow As Long
    Dim lLastRow As Long
    
    Set wkS = ActiveSheet
    With wkS
        lLastRow = .Cells(.Rows.Count, miIDCOL).End(xlUp).Row
        'Loop through all cells from last row to 2 and delete row if copied subheader
        For lRow = lLastRow To 2 Step -1
            If .Cells(lRow, miIDCOL).Value = msCOPYID Then
                .Cells(lRow, miIDCOL).EntireRow.Delete
            End If
        Next lRow
    End With
    
End Sub
 
'---------------------------------------------------------------------------------------
' Procedure : listHPageBreaks
' Author    : Stellan
' Date      : 2009-02-16
' Purpose   : List the addresses of all pagebreaks on the activesheet in immediate window
'---------------------------------------------------------------------------------------
'
Sub listHPageBreaks()
    Dim rw As Range
    Dim i As Long
    For i = ActiveSheet.HPageBreaks.Count To 1 Step -1
        Debug.Print ActiveSheet.HPageBreaks(i).Location.Address
    Next i
End Sub

Open in new window

Page-break-and-repeat-header-exa.xls
0
 
Steph_MAuthor Commented:
Stellan,

That is awesome, thank you!  I will award the points as soon as I transfer it over to the real workbook.  I just don't want to close the post until I'm sure I don't have any other questions.

Stephanie
0
 
Steph_MAuthor Commented:
Stellan,

I'm sorry to have to report this, but when I run the code I get a run-time error 9 Subscript out of range error.  Here's a few things I tried:

First I tried the code in my real book and I got a few different results:
    Once it copied a row 6 times - without a subheader.
    A few times it copied the same subheader 10 different times with a pagebreak after each one.

So I moved my report over to the sample workbook to see if it behaved differently.  It was better, but it generated the Run Time error #9.  Here is where it breaks:

Function FirstAutoHPageBreak(wkS As Worksheet) As Range

    Dim i As Long
    Dim pbsH As HPageBreaks
   
    Set pbsH = wkS.HPageBreaks
   
    For i = 1 To pbsH.Count
        If pbsH(i).Type = xlPageBreakAutomatic Then  ----- page break = -4105
            Set FirstAutoHPageBreak = pbsH(i).Location
            Exit Function
        End If
    Next i
   
End Function

Both workbooks had the first row as the header row (set through page set) and the reports were landscaped.  I made sure the word "Subheader" was in the same column.   Does it make any difference if the set print range is set?

I'll keep trying, but if you have any suggestions I would appreciate them.

Stephanie



0
 
StellanRosengrenCommented:
I think that the print range needs to be set. Please try that.

Would it be possible for you to upload the real data? If not, can you tell me how it differs from the sample data?

Stellan
0
 
Steph_MAuthor Commented:
Stellan,

Sorry for the delay - I had to remove the confidential information.  There really isn't much difference
between the dummy records I was using and the sample provided, except the dummy records are longer and have a varienty of comment cells with hard line breaks and word wraps.  I did notice on one really long comment cell, the line broke between the row instead of prior to the row (meaning the record appeared on the bottom of page x and top of page y).  

I thought of this and was wodering if this might would be worth a try - would it make any difference if I included a blank row under each hearder (on page format, rows to repeat would be 1 and 2 instead of just 1).  That would eliminate the always having to insert the repeat sub-header, instead, the code would just look for the last sub-header used and copy it.  This would not always be 100% but would be huge improvement for 100% manual insert the users have to do now.

Thank you again and I'm sorry this question has been elevated to to the headache status.  
Stephanie
SubHeader-Sample2.xls
0
 
StellanRosengrenCommented:
Hi Stephanie,

I think that I have found the reason for the error. When accessing the HPageBreaks collection you can get the subscript out of range error. I found some discussions on the web and the suggestion to switch view to PageBreak view in the active window. I have modified the code so that xlPageBreakBreview is set at the beginning and in the function FirstAutoHPageBreak the error handling routine is switching again. The error seem to be related to the way Excel automatically updates the pagebreaks and the switching of views may be triggering the update. I have tried DoEvents in the code but that did not work. Please find the updated code and sample file. Let us try this new version and see if we need some new ideas. I have to admit that this is a learning experience for me, but that is part of the joy with this site. No headache yet.

Regards,
Stellan
Option Explicit
 
Const msID As String = "SUBHEADER"
Const msCOPYID As String = "COPIED SUBHEADER"
Const miIDCOL As Integer = 6
 
'---------------------------------------------------------------------------------------
' Procedure : RepeatSubHeaderOnEachPage
' Author    : Stellan
' Date      : 2009-02-17
' Purpose   : Make sure that subheader is on top of each printed page
'---------------------------------------------------------------------------------------
'
Sub RepeatSubHeaderOnEachPage()
    Dim wkS As Worksheet
    Dim rC As Range
    Dim i As Long
    
    Set wkS = ActiveSheet
    'Looks like it is necessary to run in pagebreak view
    Application.ActiveWindow.View = xlPageBreakPreview
    
    'find the first manual pagebreak (always in the first column)
    Set rC = FirstAutoHPageBreak(wkS)
    
    'Loop until no automatic pagebreak is present
    Do While Not rC Is Nothing
        Debug.Print "Auto pagebreak above row: "; rC.Row
        'An automatic pagebreak has been found
        With wkS
            'Check if it happens that the auto pagebreak coincides with a subheader row
            If .Cells(rC.Row, miIDCOL).Value <> msID Then
                rC.EntireRow.Insert 'insert blank row above pagebreak location
                Set rC = rC.Offset(-1, 0) 'change rC to refer to the new row
                'Copy the first subheader that could be found above the new row
                'The method to find the subheader relies on that cells are empty for non-subheaders in the id col
                .Cells(rC.Row, miIDCOL).End(xlUp).EntireRow.Copy Destination:=rC
                'Tag the copied row so that it can be removed
                .Cells(rC.Row, miIDCOL).Value = msCOPYID
            End If
            'Add a manual pagebreak
            .HPageBreaks.Add before:=rC
        End With
        'Find the next auto pagebreak
        Set rC = FirstAutoHPageBreak(wkS)
    Loop
    
End Sub
 
'---------------------------------------------------------------------------------------
' Procedure : FirstAutoHPageBreak
' Author    : Stellan
' Date      : 2009-02-17
' Purpose   : Find the first automatic pagebreak in a worksheet
'---------------------------------------------------------------------------------------
'
Function FirstAutoHPageBreak(wkS As Worksheet) As Range
 
    Dim i As Integer
    Dim j As Integer
    Dim iMax As Integer
    Dim pbH As HPageBreak
    Dim iErrCount As Integer
    
    On Error GoTo ErrorExit
    
TryAgain:
    'If an error occurred, run again. Number of tries limited to 10
    If iErrCount > 10 Then
        MsgBox "Persistent error in FirstAutoHPageBreak"
        Exit Function
    End If
    
    With wkS
        iMax = .HPageBreaks.Count
        For i = 1 To iMax
            If .HPageBreaks(i).Type = xlPageBreakAutomatic Then
                Set FirstAutoHPageBreak = .HPageBreaks(i).Location
                Debug.Print "No of pagebreaks: "; .HPageBreaks.Count; " First auto: "; FirstAutoHPageBreak.Address
                Exit Function
            End If
        Next i
    End With
    
ErrorExit:
    If Err.Number > 0 Then
        wkS.Activate
        Application.ActiveWindow.View = xlNormalView
        Application.ActiveWindow.View = xlPageBreakPreview
        Debug.Print "Error in FirstAutoHPageBreak: " & Err.Number & " - " & Err.Description
        iErrCount = iErrCount + 1
        Resume TryAgain
    End If
End Function
 
'---------------------------------------------------------------------------------------
' Procedure : RestoreWorksheet
' Author    : Stellan
' Date      : 2009-02-17
' Purpose   : Restore activesheet by calling subs to delete copied rows and manual pagebreaks
'---------------------------------------------------------------------------------------
'
Sub RestoreWorksheet()
    Call RemoveCopiedSubheaders
    ActiveSheet.ResetAllPageBreaks
End Sub
 
'---------------------------------------------------------------------------------------
' Procedure : RemoveCopiedSubheaders
' Author    : Stellan
' Date      : 2009-02-17
' Purpose   : Delete all rows with copied subheaders in activesheet
'---------------------------------------------------------------------------------------
'
Sub RemoveCopiedSubheaders()
    Dim wkS As Worksheet
    Dim lRow As Long
    Dim lLastRow As Long
    
    Set wkS = ActiveSheet
    With wkS
        lLastRow = .Cells(.Rows.Count, miIDCOL).End(xlUp).Row
        'Loop through all cells from last row to 2 and delete row if copied subheader
        For lRow = lLastRow To 2 Step -1
            If .Cells(lRow, miIDCOL).Value = msCOPYID Then
                .Cells(lRow, miIDCOL).EntireRow.Delete
            End If
        Next lRow
    End With
    
End Sub

Open in new window

Page-break-and-repeat-header-exa.xls
0
 
StellanRosengrenCommented:
Hi again,
I looked at your new sample data. The code will not work if the cells are not empty between the "subheader" tags in column 6. I can rewrite the code if you wish to remove that requirement. Or you could use a dedicated "tag" column which can be hidden. Just change the constant like this:
Const miIDCOL As Integer = 11
which means that column K is the tag column. Hide the column so that it will not be printed. But, as I said, clear the cells between the tags in that column. I tried this on your sample data and it worked.

Regards,
Stellan
0
 
Steph_MAuthor Commented:
Stellan, thank you again!  I misunderstood the first time about the empty cell and appreciate the second explanation you provided.  You put a lot of time in this and it was something I could not do for the users.  

Stephanie
0
 
StellanRosengrenCommented:
Stephanie,
Thank you for your kind words. I am so glad that I could help. Actually I learnt something new which will be useful in my own projects. Of course I am grateful for the points too.

Stellan
0

Featured Post

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

  • 7
  • 6
Tackle projects and never again get stuck behind a technical roadblock.
Join Now