VBA: Sum based on Column Criteria

[Tiger9136]

Hello, I am needing help to sum values for each series. The series is in column A and the values are in column B. I have place an example at the bottom. I would like to do this with VBA.

Thanks

What I Have		What I Need
SERIAL	VALUE		SERIAL	VALUE
221	1		221	10
221	2		221
221	3		221
221	4		221
445	5		445	18
445	6		445
445	7		445
777	8		777	27
777	9		777
777	10		777

<colgroup><col span="2"><col><col span="2"></colgroup><tbody>
</tbody>

 

[MickG]

Try this for results starting "D2".

[COLOR="Navy"]Sub[/COLOR] MG07Dec24
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, Temp [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] Rng = Range("A2", Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]Set[/COLOR] Temp = Rng(1)
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Not Dn.Value = Temp [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]Set[/COLOR] Temp = Dn
    [COLOR="Navy"]End[/COLOR] If
Dn.Offset(, 3) = Dn.Value
Temp.Offset(, 4) = Temp.Offset(, 4) + Dn.Offset(, 1).Value
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Joe4]

Assuming that your data is in columns A and B and you want to replace the current values in column B with your desired result, try this:

Sub MyMacro()
'
    Dim lastRow As Long
    
'   Find last row with data in column A
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row

'   Populate column C with formula
    Range("C1").FormulaR1C1 = "VALUE"
    Range("C2:C" & lastRow).FormulaR1C1 = _
        "=IF(RC[-2]<>R[-1]C[-2],SUMIF(C[-2],RC[-2],C[-1]),"""")"

'   Copy values from column C to column B
    Columns("C:C").Copy
    Range("B1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    
'   Delete column C
    Columns("C:C").Delete Shift:=xlToLeft
    
End Sub

 

[Tiger9136]

This seems to do exactly what I need except it deletes the column C which contains descriptions, is there a way to do this without using column c?

Thanks

 

[Tiger9136]

I can use this code, I changed C to Q which is the next empty column. The issue that I am having is that the actual values are in column K instead of B. Can you show me where to adjust so it will use column A for the serial, K for the values and Q for the formula. Thanks

 

[Joe4]

See if this does what you want:

Sub MyMacro()
'
    Dim lastRow As Long
    
'   Find last row with data in column A
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row

'   Populate column Q with formula
    Range("Q2:Q" & lastRow).FormulaR1C1 = _
        "=IF(RC[-16]<>R[-1]C[-16],SUMIF(C[-16],RC[-16],C[-6]),"""")"

End Sub