Sub-Total In Footer For Each Page

[Steve Troughton]

My Problem: -

Excel Version 2016
Firstly, apologies if I have not adhered to any of the Forum rules, it is my first post.

I want a sum total (in a footer) for each page. Pretty simple I thought until I discovered excel do not provide the function to do this i.e. do sum totals in footers Grrrrrr!!!!

We produce ‘Schedules of Works’ with the furthest most right-hand column (this being ‘F’) used as a pricing column for contractors to enter their prices alongside our work descriptions. These prices / costs should then total at the bottom for each page.

Each blank page roughly starts off with 50 rows, so, I could just put a sum total in row 51. However, as we write the schedule, this could change to as little as 10 rows per page dependent upon the size of the descriptions we write in each row. As such the sum-total would be pushed off the bottom and onto the next page.

This wouldn’t be too bad for our Admin to re-configure if it were only a few pages, however each schedule can be up to 80 pages long, times that by 20 or so people in the office producing many schedules. This now becomes a lot of editing work.

Not one to let this defeat me, I have spent the last week Googling a hopeful answer from many excel forums / pod cast videos etc as follows: -

1^st Try: - (using the formula bar)

=IF(MOD(ROW(),45)=5,SUM(G&6:G6),””)

This works fine to a degree however with the following problems for me: -
1) – If I need to insert 5 or more rows it pushes the sub-total onto the next page
2) – If I the row height increase through needing to enter a large description / amount of txt it pushes the sub-total onto the next page
3) The sub-total isn’t in a footer anyway, just at the bottom of the page. Although maybe it could be referenced in the footer via a macro or something.

2^nd Try: - (using a macro)

Sub PrintWithTotals()

‘ Fill in this information
FirstDataRow = 6
RowsPerPage = 50
ColToTotal = 6

‘ Find how many rows today
HeadRow = FirstDataRow - 1
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
PageCount = (FinalRow - HeadRow) / RowsPerPage
PageCount = Application.WorksheetFunction.RoundUp(PageCount, 0)

For i = 1 To PageCount
ThisPageFirstRow = (i - 1) * RowsPerPage + HeadRow + 1
ThisPageLastRow = ThisPageFirstRow + RowsPerPage - 1
TotalThisPage = Application.WorksheetFunction. _
Sum(Cells(ThisPageFirstRow, ColToTotal).Resize(RowsPerPage, 1))


‘ Change the Footer for this page
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.RightFooter = "Total This Page $" & Format(TotalThisPage, "#,##0.00")
End With
Application.PrintCommunication = True

‘ Print this page
ActiveWindow.SelectedSheets.PrintOut From:=i, To:=i, Copies:=1, Collate _
:=True, IgnorePrintAreas:=False

Next i

‘ Clear the footer in case someone prints without the macro
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftFooter = "Use PrintWithTotals Macro "
.RightFooter = " "
End With
Application.PrintCommunication = True

End Sub

This doesn’t produce any errors, nevertheless it doesn’t work. When I step through the code either using F8 or the debug step-in procedure it misses out the section I have highlighted blue above. So I'm guessing it isn't running this part properly.

Watching the video from MrExcel, he steps through it fine and it works fine.

To re-cap, I am just after getting a sub-total (for each page) in a footer regardless of how many rows I have for that page, delete, add or increase in size.

I am at a loss what else to try. If anyone could please help, the winner gets a Big Hug!

Cheers Steve