Page break,Page subtotal,lastly grand total by a click.

Manually every page break insert row than subtotal is difficult ,if many page in a report. Lastly grand total in last page time waste because Scrolling tab and go to last page . I search this easy way it solve but not find in net .
Find one thing but it open another page and subtotal not header row repeat.So , I try and success .At first page set up and paper size select then click button or macro with in second all page break insert a row where page break then subtotal in this inserted row and last page grand total in two row for confirmation . Last row grand total delete manually If you confirm this two grand total same . For all thing I use Vb code. This Vb code is..

Sub Grand_Total_sub_total()
Dim rng As Range
With Sheets("Sheet1")  'amend as appropriate
  Set rng = .Cells(.Rows.Count, "B").End(xlUp).Offset(3).Resize(, 7) 'here use 7 for 7 column sum ("B" is for wich column start Auto sum)
End With
With rng
  .FormulaR1C1 = _
    "=SUM(R2C:R[-1]C)"
  .Font.Bold = True
  .Font.Size = 12
End With
With ActiveSheet.UsedRange
        .Value = .Value
    End With
    '------Developed by Md.Shaiful Islam talukder------
     Dim ws As Worksheet
    Dim pb As Variant
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
     'Develope by Md.Shaiful Islam Talukder.
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    ws.Activate
    ActiveWindow.View = xlPageBreakPreview
    For Each pb In ws.HPageBreaks
        Set rng = ws.Range("A" & pb.Location.Row)
        If rng.Value <> "" And rng.Offset(-1, 0).Value <> "" Then
            rng.Offset(-1, 0).EntireRow.Insert
        End If
    Next pb
    ActiveWindow.View = xlNormalView
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    For Each NumRange In _
Selection.SpecialCells(xlConstants, xlNumbers).Areas
For ColCount = 0 To (NumRange.Columns.Count - 1)
SumAddr = NumRange.Offset(0, ColCount). _
Resize(NumRange.Rows.Count, 1).Address(False, False)
NumRange.Offset(NumRange.Rows.Count, ColCount). _
Resize(1, 1).Formula = _
"=SUBTOTAL(9," & SumAddr & ")"
Next ColCount
Next NumRange
With ActiveSheet.UsedRange
        .Value = .Value
    End With
End Sub
'To use this UDF push Alt+F11 and go Insert>Module and paste in the code. Push Alt+Q and save. 
'--------------------Md.Shaiful Islam Talukder---------                 

   

Download the workbook

Tweet