Autosum vba for each new sheet added to workbook

Question

My current VBA provides an sum function for pre-defined columns within worksheets which are specified and defined in the code. This works fine, however I am adding new worksheets to this workbook on a daily basis, and its therefore not feasible to edit the code everyday to add a new worksheet and range for it to sum.

Is there a way I can edit my current code in order for it to conduct the sum function for every single worksheet in the workbook? I have attached the current code for reference below.

    Sub AutoSum()
Sheets("MASTER ACCOUNT REVENUE").Select
Range("D4").Select
Selection.End(xlDown).Select
ActiveCell.Offset(2, 0).Select
Dim cel1 As String, cel2 As String
cel1 = ActiveCell.Offset(-2, 0).End(xlUp).Address
cel2 = ActiveCell.Offset(-1).Address
ActiveCell.Value = "=sum(" & (cel1) & ":" & (cel2) & ")"
End Sub

BruceWayne · Accepted Answer · 2018-10-16T15:27:28.193

Yes, just loop through the sheets. NOTE: It's best to avoid using .Select/.Activate

Sub autoSum_AllSheets()
Dim ws As Worksheet
Dim cel1 As String, cel2 As String
Dim firstCel As Range

For Each ws In ActiveWorkbook.Worksheets
    With ws
        Set firstCel = .Range("D4").End(xlDown).Offset(2, 0)
        cel1 = firstCel.Offset(-2, 0).End(xlUp).Address
        cel2 = firstCel.Offset(-1).Address
        firstCel.Value = "=SUM(" & cel1 & ":" & cel2 & ")"
    End With
Next ws

End Sub

Note: I'm aware of the redundencies in the Offset() parts, but just kept them in for OP to see how to more easily avoid .Select/.Activate.

Edit: To loop through a bunch of columns, one (albeit kludgy) way is to just add the column letters to an array:

Sub autoSum_AllSheets()
Dim ws As Worksheet
Dim cel1 As String, cel2 As String
Dim firstCel As Range

Dim cols() As Variant
cols = Array("D", "E", "F")

Dim i As Long
For Each ws In ActiveWorkbook.Worksheets
    With ws
        For i = LBound(cols) To UBound(cols)
            Set firstCel = .Range(cols(i) & "4").End(xlDown).Offset(2, 0)
            firstCel.Select
            cel1 = firstCel.Offset(-2, 0).End(xlUp).Address
            cel2 = firstCel.Offset(-1).Address
            firstCel.Value = "=SUM(" & cel1 & ":" & cel2 & ")"
        Next i
    End With
Next ws

End Sub

Please note though, if the Column does not have any information in a cell after row 5, you will get an error (because the .XlDown goes to the very last row, and you can't then Offset(2,0) from there.)

thanks! @BruceWayne your suggestion worked. If I wanted to add a second range of columns which I would like to sum how would I add it to the vba? — NHure92, Oct 16 '18 at 15:21
thank you for the suggestion, however I get a run-time error 1004: Application-defined or object-defined error. What i've done to the edited code you suggested is add the column range start point in cols = Array("J3", "C3") section. Is there anything else I need to change in order to get the code to function? — NHure92, Oct 16 '18 at 15:44
@NHure92 - Did you change it to literally `cols = Array("J3", "C3")` and leave the rest? If so, then you should change `Set firstCel = ...` to `... = .Range(cols(i)).End(xlDown).Offset(2,0)` — BruceWayne, Oct 16 '18 at 15:56

score 0 · Answer 2 · answered Oct 16 '18 at 15:07

Yes add:

Dim wscount as long
dim i as long
     wscount = Activeworkbook.Worksheets.Count
 for i = 1 to wscount
Sheets(i).Select
Range("D4").Select
 Selection.End(xlDown).Select
ActiveCell.Offset(2, 0).Select
Dim cel1 As String, cel2 As String
cel1 = ActiveCell.Offset(-2, 0).End(xlUp).Address
cel2 = ActiveCell.Offset(-1).Address
ActiveCell.Value = "=sum(" & (cel1) & ":" & (cel2) & ")"
next i

End Sub

Autosum vba for each new sheet added to workbook

2 Answers2