none
How to Apply Page Break based on cell value RRS feed

  • Question

  • Dear All,

    I am having the report in below format Data Range : Column A to Column S.

    And their are approx. more than 3000 rows of data , I have and applying the page break manually.

    basically I need to adjust all the bunch of data to different pages.

    For Example : From Header column A Employee ID to Column S Vendor Contact should be in Page 1.

    If again header comes below with Employee Name than it should be adjust to page 2 and so on....... 

    Please suggest me if is there any shortcut trick to apply page break based on this condition ?

    Link to sample file: https://1drv.ms/x/s!Ap80Ku6M2Tw5gR9ggTN1T-w7DWI8

    Thanks in advance for your valuable suggestion.


    Rajender


    Rajender

    Friday, November 18, 2016 2:25 PM

Answers

  • Hi,

    You can use the below macro which will go one by one every row of your excel sheet where there is a data. Try to find if Text in a cell in Column A is "Employee Name" = i.e. Header then it will apply a page break there.

    This will continue till the end of your data.

    Sub pageBreak()
    Dim iRow
    Dim MaxRow
    With Worksheets("Sheet1")
        .ResetAllPageBreaks
        MaxRow = .UsedRange.Rows.Count
        For iRow = 3 To MaxRow
             If .Range("A" & iRow).Value = "Employee Name" Then
                .Rows(iRow).pageBreak = xlPageBreakManual
            End If
        Next
    End With
    End Sub



    Vish Mishra

    • Marked as answer by AskQuery1984 Wednesday, November 23, 2016 4:58 PM
    Friday, November 18, 2016 3:37 PM

All replies

  • Hi,

    You can use the below macro which will go one by one every row of your excel sheet where there is a data. Try to find if Text in a cell in Column A is "Employee Name" = i.e. Header then it will apply a page break there.

    This will continue till the end of your data.

    Sub pageBreak()
    Dim iRow
    Dim MaxRow
    With Worksheets("Sheet1")
        .ResetAllPageBreaks
        MaxRow = .UsedRange.Rows.Count
        For iRow = 3 To MaxRow
             If .Range("A" & iRow).Value = "Employee Name" Then
                .Rows(iRow).pageBreak = xlPageBreakManual
            End If
        Next
    End With
    End Sub



    Vish Mishra

    • Marked as answer by AskQuery1984 Wednesday, November 23, 2016 4:58 PM
    Friday, November 18, 2016 3:37 PM
  • Hi Vish,

    Above Macro working fine, but after running the macro I need to adjust the column ranges till S column to show all columns from A to S in 1 page.

    what other changes can we do to adjust it till column S as well ?

    Regards,

    Rajender


    Rajender

    Friday, November 18, 2016 4:08 PM
  • Hi Rajender,

    To keep all the columns in one page would be difficult even if you make the pageLayout orientation as "LandScape".

    To do this go to your sheet,

    Step 1: go to PageLayout Tab (excel 2007/+) and Change the Orientation to Landscape.

    Step 2:  Click on the Page Layout on the Right corner down of your workbook 

    Step 3: Now adjust the Page Layout Margin from left and right side and also adjust the width of the columns to fit in one page. As soon as you start reducing the width you can see that columns will start moving to one page. Do this till all your columns are there in one page and then go back to Normal view. (this setting will remain there always unless you change the size of the column or add a new column etc.)

    Let me know if this helps.


    Vish Mishra

    Friday, November 18, 2016 5:18 PM
  • Hi Vish,

    Thanks a lot for your valuable assistance.

    I cross checked it and its working fine for me. But there is one more issue. I sheet which I inserting the page page, it generated with a macro( combining the data of ~50 sheets). and every time I am running that macro its deleting this sheet and generating a new sheet.

    In this case I have to follow the above steps again.

    If you can suggest the change in that macro as well , like instead of deleting it just delete only the data, so that above mentioned setting will not change ?

    Sub CopyDataWithoutHeaders()
        Dim sh As Worksheet
        Dim DestSh As Worksheet
        Dim Last As Long
        Dim shLast As Long
        Dim CopyRng As Range
        Dim StartRow As Long
    
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With
    
        ' Delete the summary sheet if it exists.
        Application.DisplayAlerts = False
        On Error Resume Next
        ActiveWorkbook.Worksheets("MergeSheet").Delete
        On Error GoTo 0
        Application.DisplayAlerts = True
    
        ' Add a new summary worksheet.
        Set DestSh = ActiveWorkbook.Worksheets.Add
        DestSh.Name = "MergeSheet"
    
        ' Fill in the start row.
        StartRow = 1
    
        ' Loop through all worksheets and copy the data to the
        ' summary worksheet.
        For Each sh In ActiveWorkbook.Worksheets
            If sh.Name <> DestSh.Name Then
    
                ' Find the last row with data on the summary
                ' and source worksheets.
                Last = lastrow(DestSh)
                shLast = lastrow(sh)
    
                ' If source worksheet is not empty and if the last
                ' row >= StartRow, copy the range.
                If shLast > 0 And shLast >= StartRow Then
                    'Set the range that you want to copy
                    Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast))
    
                   ' Test to see whether there are enough rows in the summary
                   ' worksheet to copy all the data.
                    If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
                       MsgBox "There are not enough rows in the " & _
                       "summary worksheet to place the data."
                       GoTo ExitTheSub
                    End If
    
                    ' This statement copies values and formats.
                    CopyRng.Copy
                    With DestSh.Cells(Last + 1, "A")
                        .PasteSpecial xlPasteValues
                        .PasteSpecial xlPasteFormats
                        Application.CutCopyMode = False
                    End With
    
                End If
    
            End If
        Next
    
    ExitTheSub:
    
        Application.Goto DestSh.Cells(1)
    
        ' AutoFit the column width in the summary sheet.
        DestSh.Columns.AutoFit
    
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With
    End Sub

    Regards,

    Rajender


    Rajender

    Monday, November 21, 2016 4:26 AM
  • Hi You can try following code which will do the pagesetup as well which will fit in one page:

    Sub CopyDataWithoutHeaders()
        Dim sh As Worksheet
        Dim DestSh As Worksheet
        Dim Last As Long
        Dim shLast As Long
        Dim CopyRng As Range
        Dim StartRow As Long
    
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With
    
        ' Clear the summary sheet if it exists.
        Application.DisplayAlerts = False
        On Error Resume Next
        ActiveWorkbook.Worksheets("MergeSheet").Delete
        On Error GoTo 0
        Application.DisplayAlerts = True
    
        ' Add a new summary worksheet.
        Set DestSh = ActiveWorkbook.Worksheets.Add
        DestSh.Name = "MergeSheet"
    
        ' Fill in the start row.
        StartRow = 1
    
        ' Loop through all worksheets and copy the data to the
        ' summary worksheet.
        For Each sh In ActiveWorkbook.Worksheets
            If sh.Name <> DestSh.Name Then
    
                ' Find the last row with data on the summary
                ' and source worksheets.
                Last = lastrow(DestSh)
                shLast = lastrow(sh)
    
                ' If source worksheet is not empty and if the last
                ' row >= StartRow, copy the range.
                If shLast > 0 And shLast >= StartRow Then
                    'Set the range that you want to copy
                    Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast))
    
                   ' Test to see whether there are enough rows in the summary
                   ' worksheet to copy all the data.
                    If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
                       MsgBox "There are not enough rows in the " & _
                       "summary worksheet to place the data."
                       GoTo ExitTheSub
                    End If
    
                    ' This statement copies values and formats.
                    CopyRng.Copy
                    With DestSh.Cells(Last + 1, "A")
                        .PasteSpecial xlPasteValues
                        .PasteSpecial xlPasteFormats
                        Application.CutCopyMode = False
                    End With
    
                End If
    
            End If
        Next
    
    ExitTheSub:
    
        Application.Goto DestSh.Cells(1)
    
        ' AutoFit the column width in the summary sheet.
        With DestSh.PageSetup
            .Zoom = False
            .FitToPagesWide = 1
            .FitToPagesTall = False
        End With
    
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With
    End Sub
    

    Or you can use following where instead of deleting the sheet it is just clearing the data of the sheet:

    Sub CopyDataWithoutHeaders()
        Dim sh As Worksheet
        Dim DestSh As Worksheet
        Dim Last As Long
        Dim shLast As Long
        Dim CopyRng As Range
        Dim StartRow As Long
    
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With
    
        ' Clear the summary sheet if it exists.
        ActiveWorkbook.Worksheets("MergeSheet").UsedRange.ClearContents
        On Error GoTo 0
    
    
        ' Add a new summary worksheet.
        Set DestSh = ActiveWorkbook.Worksheets.Add
        DestSh.Name = "MergeSheet"
    
        ' Fill in the start row.
        StartRow = 1
    
        ' Loop through all worksheets and copy the data to the
        ' summary worksheet.
        For Each sh In ActiveWorkbook.Worksheets
            If sh.Name <> DestSh.Name Then
    
                ' Find the last row with data on the summary
                ' and source worksheets.
                'Last = lastrow(DestSh)
                'shLast = lastrow(sh)
    
                ' If source worksheet is not empty and if the last
                ' row >= StartRow, copy the range.
                If shLast > 0 And shLast >= StartRow Then
                    'Set the range that you want to copy
                    Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast))
    
                   ' Test to see whether there are enough rows in the summary
                   ' worksheet to copy all the data.
                    If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
                       MsgBox "There are not enough rows in the " & _
                       "summary worksheet to place the data."
                       GoTo ExitTheSub
                    End If
    
                    ' This statement copies values and formats.
                    CopyRng.Copy
                    With DestSh.Cells(Last + 1, "A")
                        .PasteSpecial xlPasteValues
                        .PasteSpecial xlPasteFormats
                        Application.CutCopyMode = False
                    End With
    
                End If
    
            End If
        Next
    
    ExitTheSub:
    
        Application.Goto DestSh.Cells(1)
    
        ' AutoFit the column width in the summary sheet.
        With DestSh.PageSetup
            .Zoom = False
            .FitToPagesWide = 1
            .FitToPagesTall = False
        End With
    
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With
    End Sub
    


    Vish Mishra

    Monday, November 21, 2016 5:17 AM
  • Hi Vish,

    In first code its shrink all the columns and the result showing multiple block of header with Employee name in same page. where as I need 1 block starting from Employee name till next employee name header in separate pages.

    The old code which you provided in your first post to is working fine for me only was the manual adjust I need to do at last by dragging the Blue line to last column in Page Break Preview.

    In second code I am getting the error :-" That name already taken Try different Name"

    Please suggest.

    Regards,

    Rajender


    Rajender

    Tuesday, November 22, 2016 5:23 PM
  • Hi Rajender,

    Try the second one. There is one statement which was commented and hence you were getting this error:

    Sub CopyDataWithoutHeaders()
        Dim sh As Worksheet
        Dim DestSh As Worksheet
        Dim Last As Long
        Dim shLast As Long
        Dim CopyRng As Range
        Dim StartRow As Long
    
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With
    
        ' Clear the summary sheet if it exists.
        ActiveWorkbook.Worksheets("MergeSheet").UsedRange.ClearContents
        On Error GoTo 0
    
    
        ' Add a new summary worksheet.
        Set DestSh = ActiveWorkbook.Worksheets.Add
        DestSh.Name = "MergeSheet"
    
        ' Fill in the start row.
        StartRow = 1
    
        ' Loop through all worksheets and copy the data to the
        ' summary worksheet.
        For Each sh In ActiveWorkbook.Worksheets
            If sh.Name <> DestSh.Name Then
    
                ' Find the last row with data on the summary
                ' and source worksheets.
                 Last = lastrow(DestSh)
                 shLast = lastrow(sh)
    
                ' If source worksheet is not empty and if the last
                ' row >= StartRow, copy the range.
                If shLast > 0 And shLast >= StartRow Then
                    'Set the range that you want to copy
                    Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast))
    
                   ' Test to see whether there are enough rows in the summary
                   ' worksheet to copy all the data.
                    If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
                       MsgBox "There are not enough rows in the " & _
                       "summary worksheet to place the data."
                       GoTo ExitTheSub
                    End If
    
                    ' This statement copies values and formats.
                    CopyRng.Copy
                    With DestSh.Cells(Last + 1, "A")
                        .PasteSpecial xlPasteValues
                        .PasteSpecial xlPasteFormats
                        Application.CutCopyMode = False
                    End With
    
                End If
    
            End If
        Next
    
    ExitTheSub:
    
        Application.Goto DestSh.Cells(1)
    
        ' AutoFit the column width in the summary sheet.
        With DestSh.PageSetup
            .Zoom = False
            .FitToPagesWide = 1
            .FitToPagesTall = False
        End With
    
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With
    End Sub


    Vish Mishra

    Tuesday, November 22, 2016 9:17 PM