VBA Code for Summing Multiple Dynamic Ranges in One Column

[FrenchCelt]

Hello,

I have a spreadsheet with a column which lists the total of daily output in various categories (each one in a different row) for multiple people, and I want to be able to sum that output in a row at the bottom of each person's summary. I have a Total row inserted between the bottom row for one person and the top row of the next person, and I have the VBA code looking for the cell with Total in the appropriate row and offsetting to the correct cell where I want the sum to appear, but I don't know how to get it to sum the numbers above that only include the person in question. The number of rows involved is different for each person and will also vary for the same person day to day, so I can't use any constants. The only other way to identify which numbers should be included is that the person's name appears in Column A in every cell I need to sum in Column I, so if I can get it to look first at the row with Total, offset 7 cells to Column I, then look up every row with, say, userA in Column A that has a corresponding value in Column I, and sum them up, then I would be set.

Any help would be appreciated.

 

[jolivanes]

Reg Post #29 .
Change the Sheet Name in the code.
There is no error checking for if a Range is empty as in your example for Column N, Cells 30 to 34.

 

[FrenchCelt]

This worked great! Thanks a lot!

 

[FrenchCelt]

This code also worked. Thanks!

 

[JLGWhiz]

Thanks for the feedback,'
regards, JLG

 

[FrenchCelt]

It turns out I need to do a weighted average for Column N (regular average is fine for Column L). Basically, the number of minutes per labor activity with an MS% (from Column N) has to be divided by the total minutes for that user to obtain the % of time spent in each activity. Then the MS% for each labor activity in Column N would need to be multiplied by the % of time for that activity to obtain the partial MS, and then finally all the partial MS values would need to be summed to obtain the weighted average for that user. For example, user1 in the dummy file I linked would require ((K7/K13)*N7)+((K11/K13)*N11) to calculate user1's weighted average in N13.

Can this code be amended to account for what I just described?

Dim lr As Long, j As Long, lst As Range, a As String, i As Long, ii As Long    Dim sumArr, avArr
    sumArr = Array(9, 10, 11)
    avArr = Array(12, 14)
    lr = Sheets("LM Throughput Report").Cells(Rows.Count, 1).End(xlUp).Row
    i = 11
    j = 5
    Application.ScreenUpdating = False
    Do Until Cells(j, 1).Value = ""
        a = Cells(j, 1).Value
        Set lst = Range("A:A").Find(a, After:=Cells(1, 1), SearchDirection:=xlPrevious, LookAt:=xlWhole)
            For i = LBound(sumArr) To UBound(sumArr)
                Cells(lst.Row + 1, sumArr(i)).Value = WorksheetFunction.Sum(Range(Cells(j, sumArr(i)), Cells(lst.Row, sumArr(i))))
            Next i
            For ii = LBound(avArr) To UBound(avArr)
                Cells(lst.Row + 1, avArr(ii)).Value = WorksheetFunction.Average(Range(Cells(j, avArr(ii)), Cells(lst.Row, avArr(ii))))
            Next ii
        j = lst.Row + 2
    Loop
    Application.ScreenUpdating = True

 

[jolivanes]

You have values in Column "N"
Are that values like in your example or are that normally formulas?

 

[jolivanes]

This is based on Values for Column "N"
If they are Formulas, change the SpecialCells to (xlCellTypeFormulas)
Make sure to try it on a copy of your workbook first and check that the answers are right.

Sub Sum_And_Average_Blocks_Of_Same_Values_Multiple_Columns()
    Dim lr As Long, j As Long, lst As Range, a As String, i As Long
    Dim sumArr, c As Range, wAv As Double
    sumArr = Array(9, 10, 11)
    lr = Sheets("LM Throughput Report").Cells(Rows.Count, 1).End(xlUp).Row
    i = 11
    j = 5
    Application.ScreenUpdating = False
    Do Until Cells(j, 1).Value = ""
        a = Cells(j, 1).Value
        Set lst = Range("A:A").Find(a, After:=Cells(1, 1), SearchDirection:=xlPrevious, LookAt:=xlWhole)
            For i = LBound(sumArr) To UBound(sumArr)
                If WorksheetFunction.CountA(Range(Cells(j, sumArr(i)), Cells(lst.Row, sumArr(i)))) <> 0 Then
                    Cells(lst.Row + 1, sumArr(i)).Value = WorksheetFunction.Sum(Range(Cells(j, sumArr(i)), Cells(lst.Row, sumArr(i))))
                End If
            Next i
            
            If WorksheetFunction.CountA(Range(Cells(j, 12), Cells(lst.Row, 12))) <> 0 Then
                Cells(lst.Row + 1, 12).Value = WorksheetFunction.Average(Range(Cells(j, 12), Cells(lst.Row, 12)))
            End If
            
            If Not WorksheetFunction.CountA(Range(Cells(j, 14), Cells(lst.Row, 14))) = 0 Then
                For Each c In Range(Cells(j, 14), Cells(lst.Row, 14)).SpecialCells(xlCellTypeConstants)
                    wAv = wAv + (c.Offset(, -3).Value / Cells(lst.Row + 1, 11).Value) * c.Value
                Next c
                Cells(lst.Row + 1, 14).Value = wAv
            End If
            
            wAv = 0
            
        j = lst.Row + 2
    Loop
    Application.ScreenUpdating = True
End Sub

 

[FrenchCelt]

This is based on Values for Column "N"
If they are Formulas, change the SpecialCells to (xlCellTypeFormulas)
Make sure to try it on a copy of your workbook first and check that the answers are right.

The code worked as requested, and thank you so much for that, but I learned that I had the wrong idea about how to do the weighted average.

The correct method is to first sum all minutes in Column K that also has a corresponding value (MS%) in Column N. For example, with user1, I first need to sum K7 and K11. I'll call this value X. X then replaces K13 in the formula I gave before: ((K7/X)*N7)+((K11/X)*N11)

Can you adjust the VBA code to account for this?

 

[jolivanes]

Same as before. Check it out thoroughly first.

Sub Sum_And_Average_Blocks_Of_Same_Values_Multiple_Columns()
    Dim lr As Long, j As Long, lst As Range, a As String, i As Long, x As Double
    Dim sumArr, c As Range, wAv As Double
    sumArr = Array(9, 10, 11)
    lr = Sheets("LM Throughput Report").Cells(Rows.Count, 1).End(xlUp).Row
    i = 11
    j = 5
    Application.ScreenUpdating = False
    Do Until Cells(j, 1).Value = ""
        a = Cells(j, 1).Value
        Set lst = Range("A:A").Find(a, After:=Cells(1, 1), SearchDirection:=xlPrevious, LookAt:=xlWhole)
            For i = LBound(sumArr) To UBound(sumArr)
                If WorksheetFunction.CountA(Range(Cells(j, sumArr(i)), Cells(lst.Row, sumArr(i)))) <> 0 Then
                    Cells(lst.Row + 1, sumArr(i)).Value = WorksheetFunction.Sum(Range(Cells(j, sumArr(i)), Cells(lst.Row, sumArr(i))))
                End If
            Next i
            
            If WorksheetFunction.CountA(Range(Cells(j, 12), Cells(lst.Row, 12))) <> 0 Then
                Cells(lst.Row + 1, 12).Value = WorksheetFunction.Average(Range(Cells(j, 12), Cells(lst.Row, 12)))
            End If
            
            If Not WorksheetFunction.CountA(Range(Cells(j, 14), Cells(lst.Row, 14))) = 0 Then
                x = WorksheetFunction.Sum(Range(Cells(j, 14), Cells(lst.Row, 14)).SpecialCells(xlCellTypeConstants).Offset(, -3))
                For Each c In Range(Cells(j, 14), Cells(lst.Row, 14)).SpecialCells(xlCellTypeConstants)
                    wAv = wAv + (c.Offset(, -3).Value / x) * c.Value
                Next c
                Cells(lst.Row + 1, 14).Value = wAv
            End If
            x = 0
            wAv = 0
            
        j = lst.Row + 2
    Loop
    Application.ScreenUpdating = True
End Sub

When answering, please don't quote whole posts. Too much not needed clutter.
You can refer to a Post number in needed.

 

[FrenchCelt]

Awesome! Worked perfectly! Thanks so much!