How to sum multiple columns automatically

Where I work we perform a monthly inventory count and I must create a report for the production managers. In this report I have multiple columns to sum and after 5 years of doing this manually, it has gotten old. There has to be a way to search out these cells with code and perform this task automatically, but I'm not sure how to do it. While watching a video on VBA, I found the following code promising and can find the first empty cell when running it, but not sure what to do to insert the function and if I did, I'm not sure how to search out for the next cell to enter the function.

Sub FindFirstEmptyCell_DoLoop()

    Worksheets("Compare").Activate
    Range("F5").Activate
    
    Do
    
        If ActiveCell.Value = "" Then Exit Do
        ActiveCell.Offset(1, 0).Activate
        
    Loop

End Sub

By recording a macro, I can see the code to add the sum, but still lost as what needs to be done.

    Range("F15").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-10]C:R[-1]C)"
    Range("F27").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-10]C:R[-1]C)"
    Range("I71").Select

I have attached a spreadsheet with sample data with highlighted cells that need a sum of the cells above it.

I cannot upload a spreadsheet or image from my work computer so hopefully the explanation will be good enough. If not, I will upload it from home later tonight.

BTW... if the cells that are required to be SUMMED were always the same, I could just use a recorded macro to do the job. However, because inventory items and added and deleted throughout any given month, these locations are not always the same.

Brian

Hello BBoydAnchor ,

Welcome to the Forum!

Here is a macro that will ask you for the first cell of the column you want the sum for. This will display the sum from the starting cell to the last cell with data in the column. Your needs may be different and the code may need to adjusted accordingly but at least it is a start.

Sub SumCells()

    Dim FirstAddx As String
    Dim Rng As Range
    Dim RngEnd As Range
    Dim Wks As Worksheet
    
        Set Wks = ActiveSheet
        
        FirstAddx = InputBox("Please enter the address of the first cell in the column.")
        
        If FirstAddx = "" Then Exit Sub
        
            Set Rng = Wks.Range(FirstAddx)
            Set RngEnd = Wks.Cells(Rows.Count, Rng.Column).End(xlUp)
            Set Rng = IIf(RngEnd.Row < Rng.Row, Rng, Wks.Range(Rng, RngEnd))
            
        MsgBox "The Sum is " & WorksheetFunction.Sum(Rng)
        
End Sub

OK. I did a little more reading and figured it out. However, there is a lot more code than there probably should be and the SUM function is hard coded for only 10 cells. Also I would like to include a Grand Total that includes all the sums for each department.

These columns show the inventory values before and after the count.

Sub Macro1()

' Sum each department in column F
    Range("F4").Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-10]C:R[-1]C)"
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-10]C:R[-1]C)"
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-10]C:R[-1]C)"
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-10]C:R[-1]C)"
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-10]C:R[-1]C)"
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-10]C:R[-1]C)"
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-10]C:R[-1]C)"
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-10]C:R[-1]C)"
    ActiveCell.Offset(2, 0).Select
    'Now I need to get a sum of all the departments above

' Sum each department in column I
    Range("I4").Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-10]C:R[-1]C)"
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-10]C:R[-1]C)"
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-10]C:R[-1]C)"
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-10]C:R[-1]C)"
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-10]C:R[-1]C)"
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-10]C:R[-1]C)"
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-10]C:R[-1]C)"
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-10]C:R[-1]C)"
    ActiveCell.Offset(2, 0).Select
    'Now I need to get a sum of all the departments above
    
End Sub