How to sum multiple columns that change sizes?

**BBoydAnchor** · 12-22-2011, 10:51 AM

Below is a macro that works to sum areas of a column when each column area is just 10 cells. However, the column areas are not always the same length each time needing to run the macro. Also this seems like a lot of code for this task.

So how would this be coded to work when section areas would continually change? Also how would you create a Grand Total from all the subTotals?

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

**snb** · 12-22-2011, 10:58 AM

How to help without a sample workbook ?

**BBoydAnchor** · 12-22-2011, 11:48 AM

Originally Posted by snb

How to help without a sample workbook ?

Thanks for the quick response. The problem is that I'm behind a firewall at work and cannot upload any files.

I will take the file home with me and upload it after work.

**BBoydAnchor** · 12-22-2011, 02:26 PM

The sample spreadsheet is attached. Hopefully this will help.

**BBoydAnchor** · 12-26-2011, 10:58 PM

I'm still struggling to find a solution to this problem. Not only have I searched here on this forum, but elsewhere on the web. The best I can do is in the code below. However, there is an issue with summing up the second set of numbers as the code loops back up to cell F5 and the issue is compounded as it moves onto the other sets of numbers.

I'm sure there are some smart people out there that can solve this easily and without using old counter logic.

Also it would be useful to have a cell at the bottom that provides a Grand Total of all the sums of the columns this code is adding up.

Sub TotalMultiColumns()

    Worksheets("Compare").Activate
    Range("F5").Activate

    Do Until ActiveCell = ""
        n = n + ActiveCell.Value
        ActiveCell.Range("A2").Select
    Loop
        ActiveCell.Value = n
        n = 0
        ActiveCell.Offset(2, 0).Range("A1").Select

End Sub

**nilem** · 12-27-2011, 02:55 AM

try it

Sub ert()
Dim lr As Long, i As Long, adr As String
lr = Cells(Rows.Count, 2).End(xlUp).Row + 1
For i = 15 To lr Step 12
    Cells(i, 6).FormulaR1C1 = "=SUM(R[-10]C:R[-1]C)"
    Cells(i, 9).FormulaR1C1 = "=SUM(R[-10]C:R[-1]C)"
    Cells(i + 1, 11).Resize(, 2).Clear
    adr = adr & "," & Cells(i, 6).Address(0, 0)
Next
With Cells(i - 10, 6)
    .Formula = "=SUM(" & Mid(adr, 2) & ")"
    .Copy .Offset(, 3)
End With
End Sub

**BBoydAnchor** · 12-27-2011, 10:11 AM

Thank you very much nilem. This code worked perfectly. I just wish that I understood it.

Over time I will learn.

**BBoydAnchor** · 12-27-2011, 02:50 PM

I ran the code in the example spreadsheet I uploaded and it worked great. However, when I ran the macro in the actual report, it did not work. Since I do not understand the code shared, I cannot say where the issue is and can only guess it is because each of the departments in reality contains more than 10 inventory items each. The format in the example is identical to the actual sheet except that there are many more rows than in the example I uploaded.

So my question now is how can this code be modified to take into account that the row count will often change from month to month as items are either added to inventory or removed?

Dim lr As Long, i As Long, adr As String
lr = Cells(Rows.Count, 2).End(xlUp).Row + 1
For i = 15 To lr Step 12
    Cells(i, 6).FormulaR1C1 = "=SUM(R[-10]C:R[-1]C)"
    Cells(i, 9).FormulaR1C1 = "=SUM(R[-10]C:R[-1]C)"
    Cells(i + 1, 11).Resize(, 2).Clear
    adr = adr & "," & Cells(i, 6).Address(0, 0)
Next
With Cells(i - 10, 6)
    .Formula = "=SUM(" & Mid(adr, 2) & ")"
    .Copy .Offset(, 3)
End With
End Sub

The formula above appears to have relative reference to the cells and will only sum a column consisting of just 10 cells.

**nilem** · 12-28-2011, 03:05 AM

two versions

Sub ert()
Dim lr As Long, i As Long, j As Long, adr As String
lr = Cells(Rows.Count, 2).End(xlUp).Row + 1
For i = 5 To lr
    j = i
    Do While Len(Cells(i, 2)) > 0: i = i + 1: Loop
    Cells(i, 6).FormulaR1C1 = "=SUM(R" & j & "C:R[-1]C)"
    Cells(i, 9).FormulaR1C1 = "=SUM(R" & j & "C:R[-1]C)"
    Cells(i + 1, 11).Resize(, 2).Clear
    adr = adr & "," & Cells(i, 6).Address(0, 0)
    i = i + 1
Next
With Cells(i, 6)
    .Formula = "=SUM(" & Mid(adr, 2) & ")"
    .Copy .Offset(, 3)
End With
End Sub

or

Sub rty()
Dim r As Range, i As Long, adr As String
For Each r In Range("B5:B" & Cells(Rows.Count, 2).End(xlUp).Row).SpecialCells(2).Areas
    i = r.Row + r.Count
    Cells(i, 6).Formula = "=SUM(" & r.Offset(, 4).Address(0, 0) & ")"
    Cells(i, 9).Formula = "=SUM(" & r.Offset(, 7).Address(0, 0) & ")"
    Cells(i + 1, 11).Resize(, 2).Clear
    adr = adr & "," & Cells(i, 6).Address(0, 0)
Next r
With Cells(i + 2, 6)
    .Formula = "=SUM(" & Mid(adr, 2) & ")"
    .Copy .Offset(, 3)
End With
End Sub

**BBoydAnchor** · 12-28-2011, 11:33 AM

Thanks Nilem, you are amazing!!! I will use the second option and hopefully I will one day understand it all.

I have attached a sample spreadsheet along with my Macro Workbook with steps I take in this complete process. A lot of the code was recorded macros to begin with and the others were a combination of code people here on this forum helped with and from watching videos on Lynda.com.

If anyone wants to look through this mess and provide any tips; that would be great, but can survive with what I have so far.

Thanks again!