VBA to add subtotals to each sheet in my workbook

[BORUCH]

Hi
I have a lot of sheets in my workbook I would like an excel vba that would add subtotal
It should fInd the last empty row on each sheet and on column a write "subtotal" and then subtotal columns E ,F,G,H,I

It should also format columns G subtotal as numbers with a comma format

Thanks

 

[bferraz]

Please, try following code:

Sub Subtotals()

Dim ws As Worksheet

For Each ws In ThisWorkbook.Worksheets

    lastrow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
   
    ws.Cells(lastrow + 1, "A").Value = "Subtotal"
   
    ws.Cells(lastrow + 1, "E").Formula = "=SUBTOTAL(9,E2:E" & lastrow & ")"
    ws.Cells(lastrow + 1, "F").Formula = "=SUBTOTAL(9,F2:F" & lastrow & ")"
    ws.Cells(lastrow + 1, "G").Formula = "=SUBTOTAL(9,G2:G" & lastrow & ")"
    ws.Cells(lastrow + 1, "H").Formula = "=SUBTOTAL(9,H2:H" & lastrow & ")"
    ws.Cells(lastrow + 1, "I").Formula = "=SUBTOTAL(9,I2:I" & lastrow & ")"
   
    ws.Cells(lastrow + 1, "G").NumberFormat = "#,##0"
   
Next ws

End Sub

 

[BORUCH]

Please, try following code:

Sub Subtotals()

Dim ws As Worksheet

For Each ws In ThisWorkbook.Worksheets

    lastrow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
  
    ws.Cells(lastrow + 1, "A").Value = "Subtotal"
  
    ws.Cells(lastrow + 1, "E").Formula = "=SUBTOTAL(9,E2:E" & lastrow & ")"
    ws.Cells(lastrow + 1, "F").Formula = "=SUBTOTAL(9,F2:F" & lastrow & ")"
    ws.Cells(lastrow + 1, "G").Formula = "=SUBTOTAL(9,G2:G" & lastrow & ")"
    ws.Cells(lastrow + 1, "H").Formula = "=SUBTOTAL(9,H2:H" & lastrow & ")"
    ws.Cells(lastrow + 1, "I").Formula = "=SUBTOTAL(9,I2:I" & lastrow & ")"
  
    ws.Cells(lastrow + 1, "G").NumberFormat = "#,##0"
  
Next ws

End Sub

Thanks

can you add to this that it should center that subtotal line on every sheet, and put borders on it and auto fit it

 

[bferraz]

Sure.

Sub Subtotals()

Dim ws As Worksheet

For Each ws In ThisWorkbook.Worksheets

    lastrow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
   
    ws.Cells(lastrow + 1, "A").Value = "Subtotal"
   
    ws.Cells(lastrow + 1, "E").Formula = "=SUBTOTAL(9,E2:E" & lastrow & ")"
    ws.Cells(lastrow + 1, "F").Formula = "=SUBTOTAL(9,F2:F" & lastrow & ")"
    ws.Cells(lastrow + 1, "G").Formula = "=SUBTOTAL(9,G2:G" & lastrow & ")"
    ws.Cells(lastrow + 1, "H").Formula = "=SUBTOTAL(9,H2:H" & lastrow & ")"
    ws.Cells(lastrow + 1, "I").Formula = "=SUBTOTAL(9,I2:I" & lastrow & ")"
   
    ws.Cells(lastrow + 1, "G").NumberFormat = "#,##0"

    ws.Range("A" & lastRow + 1 & ":I" & lastRow + 1).HorizontalAlignment = xlCenter
    
    ws.Range("A" & lastRow + 1 & ":I" & lastRow + 1).Borders(xlEdgeTop).LineStyle = xlContinuous
    ws.Range("A" & lastRow + 1 & ":I" & lastRow + 1).Borders(xlEdgeBottom).LineStyle = xlContinuous
    ws.Range("A" & lastRow + 1 & ":I" & lastRow + 1).Borders(xlEdgeLeft).LineStyle = xlContinuous
    ws.Range("A" & lastRow + 1 & ":I" & lastRow + 1).Borders(xlEdgeRight).LineStyle = xlContinuous
    
    ws.Range("A" & lastRow + 1 & ":I" & lastRow + 1).EntireRow.AutoFit
   
Next ws

End Sub

 

[BORUCH]

Sure.

Sub Subtotals()

Dim ws As Worksheet

For Each ws In ThisWorkbook.Worksheets

    lastrow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
  
    ws.Cells(lastrow + 1, "A").Value = "Subtotal"
  
    ws.Cells(lastrow + 1, "E").Formula = "=SUBTOTAL(9,E2:E" & lastrow & ")"
    ws.Cells(lastrow + 1, "F").Formula = "=SUBTOTAL(9,F2:F" & lastrow & ")"
    ws.Cells(lastrow + 1, "G").Formula = "=SUBTOTAL(9,G2:G" & lastrow & ")"
    ws.Cells(lastrow + 1, "H").Formula = "=SUBTOTAL(9,H2:H" & lastrow & ")"
    ws.Cells(lastrow + 1, "I").Formula = "=SUBTOTAL(9,I2:I" & lastrow & ")"
  
    ws.Cells(lastrow + 1, "G").NumberFormat = "#,##0"

    ws.Range("A" & lastRow + 1 & ":I" & lastRow + 1).HorizontalAlignment = xlCenter
   
    ws.Range("A" & lastRow + 1 & ":I" & lastRow + 1).Borders(xlEdgeTop).LineStyle = xlContinuous
    ws.Range("A" & lastRow + 1 & ":I" & lastRow + 1).Borders(xlEdgeBottom).LineStyle = xlContinuous
    ws.Range("A" & lastRow + 1 & ":I" & lastRow + 1).Borders(xlEdgeLeft).LineStyle = xlContinuous
    ws.Range("A" & lastRow + 1 & ":I" & lastRow + 1).Borders(xlEdgeRight).LineStyle = xlContinuous
   
    ws.Range("A" & lastRow + 1 & ":I" & lastRow + 1).EntireRow.AutoFit
  
Next ws

End Sub

Thanks that worked