Subtotal function to last row in data query (VBA)

[Markylex]

Hello all,

I'm currently working on a VBA macro and have a query associated to subtotalling data within one column, down to the last row that contains data within my spreadsheet. The idea is that this macro is dynamic, as the source data will change in volume and therefore value as well.

At the moment, this is the VBA code I have:

Dim LastRow as Long
LastRow = Range("O6").End(xlDown).Row
Range("O4").Select
ActiveCell.FormulaR1C1 = "=SUBTOTAL(9,O7:O" & LastRow & ")"

The above should work by finding the last row in my data, starting from O6. I then subtotal all the data from O7 to the last row of my data, with the formula being located in O4.

With the current data set I am using, my last row is 590. The subtotal does 'work', however it seems to go to line 594 instead. What confuses me even more, is that when I run the macro line by line, it does seem to pick up 590 as the value in 'LastRow'. I've also tried setting LastRow by using rows.count, rather than xlDown, however the end result is the same.

I'd still consider myself quite a 'newbie' when it comes to VBA, so please bare with me if the issue is an obvious one.

Should you require any further information, such as screenshots of what the actual spreadsheet looks like or any further details on the other sections of macro code, let me know.

Thanks in advance for any support you can provide!

 

[Joe4]

Welcome to the Board!

Try changing this row:

LastRow = Range("O6").End(xlDown).Row

to this:

LastRow = Cells(Rows.Count, "O").End(xlUp).Row

If that still does not work, try then also adding this line under the line of code I gave you above:

MsgBox LastRow

and tell me what it returns when you run the code.


Additional note: This section of code:

Range("O4").Select
ActiveCell.FormulaR1C1 = "=SUBTOTAL(9,O7:O" & LastRow & ")"

can be combined to the more efficient:

Range("O4").FormulaR1C1 = "=SUBTOTAL(9,O7:O" & LastRow & ")"

There is usually no need to select the cells in order to work with them (doing so not only makes your code longer, "Select" statements slow your code down).
You can assign the formula to the cell directly without selecting it.

Note that using the Macro Recorder literally records every step, so you will often record code where one line ends in "Select" and the next begins with "ActiveCell" or "Selection".
Most of the time, these two lines can be combined, as I show above.

 

[Markylex]

Thanks for the welcome, it's nice to be here! Also, I appreciate your advice regarding the usage of 'Select' and 'ActiveCell', I'll certainly keep this in mind for any future work.

I changed the row to what you suggested and also added a message box. The message box outputs 590, which is the last row of the data, however the subtotal still continues to go to line 594.

 

[Joe4]

I changed the row to what you suggested and also added a message box. The message box outputs 590, which is the last row of the data, however the subtotal still continues to go to line 594.

It shouldn't. If that message box returns 590, then it should be putting 590 in the formula.

If the formula shows 594, then I have a feeling that there might be some other stuff going on here that you are not telling us about, such as:
- rows are being inserted later on
- you are running with in some Event Procedure code, which is then calling itself (and getting caught in a loop)
- something else is happening to update the value of LastRow before the formula is being populated

Can you post the ENTIRE VBA code of that procedure (including the name), so we can see all that it is doing?

 

[Markylex]

Happy to post the entire VBA code of the procedure, however there's a lot of lines, as there's a lot of editing involved.

Are you sure I can post it right here or can I upload a copy of the sheet somewhere?

 

[Joe4]

Please post the code right in this thread, using the code tags, for readability, as described here: How to Post Your VBA Code

 

[Markylex]

Sub Macro2()

Dim LastRow As Long

Sheets.Add(After:=Sheets("Pivot Table")).Name = "Credits"
Sheets("Pivot Table").Select

ActiveSheet.PivotTables("PivotTable1").PivotFields("Type").CurrentPage = _
"(All)"

With ActiveSheet.PivotTables("PivotTable1").PivotFields("Type")
.PivotItems("Clawback").Visible = False
.PivotItems("Credit Note").Visible = True
.PivotItems("Invoice").Visible = False
.PivotItems("Unallocated Cash").Visible = True
End With

Cells.Select
Selection.Copy
Sheets("Credits").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Rows("1:3").Select
Selection.ClearContents
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Range("F:F,H:H,J:J,L:L,N:N,P:P").Select
Selection.Delete Shift:=xlToLeft

Range("K4:L4").Select
Selection.Cut
Range("K5").Select
ActiveSheet.Paste
Range("E4:J4").Select
Selection.Cut
Range("E5").Select
ActiveSheet.Paste

Range("K5").Select
ActiveCell.FormulaR1C1 = "Grand Total"

'Setup overdue column

Columns("L:L").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("L5").Select
ActiveCell.FormulaR1C1 = "Overdue"
Range("L6").Select
ActiveCell.FormulaR1C1 = "=SUM(RC[-6]:RC[-2])"
Selection.AutoFill Destination:=Range("L6:L" & Range("K" & Rows.Count).End(xlUp).Row)

'Setup 90+ column

Columns("M:M").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("M5").Select
ActiveCell.FormulaR1C1 = "90+"
Range("M6").Select
ActiveCell.FormulaR1C1 = "=SUM(RC[-5]:RC[-3])"
Selection.AutoFill Destination:=Range("M6:M" & Range("K" & Rows.Count).End(xlUp).Row)

Range("N5").Select
ActiveCell.FormulaR1C1 = "Unallocated Cash"

'Delete grand total line from data.

LastRow = Cells(Rows.Count, 11).End(xlUp).Row
ActiveSheet.Range("A5:N" & LastRow).AutoFilter Field:=1, Criteria1:= _
"Grand Total"
ActiveSheet.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Cells(1, 1).EntireRow.Select
Selection.Delete Shift:=xlUp
ActiveSheet.AutoFilter.ShowAllData

'Put border around all of the data

Range("A5").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone

With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With

With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With

With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With

With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With

With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With

With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With

'Colour headings with company colours & white font.

Range("A5:N5").Select

With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 8075096
.TintAndShade = 0
.PatternTintAndShade = 0
End With

With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With

Range("A5:N5").Select
Selection.Font.Bold = True

'Insert new column for neatness

Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.ColumnWidth = 0.92

'Setup report title

Range("B2:O2").Select

With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

Selection.Merge
ActiveCell.FormulaR1C1 = "Aged Debtors Report - Credit Items"

With Selection.Font
.Name = "Calibri"
.Size = 22
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Selection.Font.Bold = True

With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With

Range("B2:O2").Select

Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With

With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With

With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With

With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With

Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

'Insert further column for neatness

Rows("3:3").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.RowHeight = 6

'Setup subtotal section

Range("E4").Select
ActiveCell.FormulaR1C1 = "Totals"
Selection.Font.Bold = True

LastRow = Cells(Rows.Count, "O").End(xlUp).Row
MsgBox LastRow

Range("O4").Select
ActiveCell.FormulaR1C1 = "=SUBTOTAL(9,R[3]C:R[" & LastRow & "]C)"
Selection.AutoFill Destination:=Range("F4:O4"), Type:=xlFillDefault

Range("E4:O4").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone

With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With

With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With

With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With

With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With

With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic

.TintAndShade = 0
.Weight = xlThin
End With

Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

Range("F4:O4").Select
Selection.Font.Bold = True
Selection.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"

'Format numbers within data to appear as currency.

ActiveSheet.Range("F7:O" & LastRow).Select
Selection.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"

'Autofit all columns

Cells.Select
Cells.EntireColumn.AutoFit

End Sub

 

[Markylex]

Apologies that there's so many lines and that it looks quite messy. I originally prepared the macro via the macro recorder and then jumped in to edit certain sections after. I also tried to comment what certain bits of the code are doing as I went along, however did not do this throughout the entire procedure.

The idea of the code is that I copy certain data from a pivot table and put it into a new sheet. I then format it into something more presentable, which members of my department can then look at and work off.

 

[Joe4]

You are doing tons of things, including inserting/deleting rows/columns, after your LastRow calculation and before your insertion of the Subtotal function.
Re-do your LastRow calculationjust before population the Subtotal function, and you should get a better result.

 

[Markylex]

I’m a little confused if I’m honest! I know that I’m doing a lot of things in the macro as a whole, however the subtotal section is one of the last things to be done.

I’ve used the LastRow variable a few times within the macro code, however as per the above, I do ‘re-calculate’ it just before doing the subtotal function.

I’ve also just put the subtotal function in a completely separate, newly created macro. I’ve then ran that new macro, after the original macro has been ran. It still does the same thing, where it puts a message box for 590, however goes down to 594.

Have I done something incorrect with the actual subtotal formula?