Sum values based on unique ID

[briguyUSA]

I have written some VBA code that allows me to filter a spreadsheet to the data I require . I am now looking to add all of the values in a column that have the same unique ID. For example, if there are 4 rows with the same ID of "123456", I want to add up all of their corresponding values to a "sum" row. Any tips on how i might tackle this?

I also won't be able to simply apply a SumIF funciton, as the filter updates with either more or less rows and such.

​

ID​	Values​
123456​	10​
123456​	12​
123456​	14​
123456​	16​
Sum​	52​
987654​	20​
987654​	22​
Sum​	42​
456789​	30​
456789​	50​
456789​	10​
Sum​	90​

 

[mumps]

Try:

Sub SumValues()
    Application.ScreenUpdating = False
    Dim ID As Range, x As Long, i As Long: i = 1
    For Each ID In Range("A2", Range("A" & Rows.Count).End(xlUp))
        If ID <> "Sum" And ID.Offset(1) <> ID Then
            Rows(ID.Row + 1).Insert
            Range("A" & (ID.Row + 1)) = "Sum"
            x = Range("B2", Range("B" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants).Areas.Item(i).Cells.Count - 1
            Range("B" & ID.Row + 1).Formula = "=Sum(B" & ID.Row - x & ":B" & ID.Row & ")"
            i = i + 1
        End If
    Next ID
    Application.ScreenUpdating = True
End Sub

 

[briguyUSA]

Try:

Sub SumValues()
    Application.ScreenUpdating = False
    Dim ID As Range, x As Long, i As Long: i = 1
    For Each ID In Range("A2", Range("A" & Rows.Count).End(xlUp))
        If ID <> "Sum" And ID.Offset(1) <> ID Then
            Rows(ID.Row + 1).Insert
            Range("A" & (ID.Row + 1)) = "Sum"
            x = Range("B2", Range("B" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants).Areas.Item(i).Cells.Count - 1
            Range("B" & ID.Row + 1).Formula = "=Sum(B" & ID.Row - x & ":B" & ID.Row & ")"
            i = i + 1
        End If
    Next ID
    Application.ScreenUpdating = True
End Sub

Thank you so much for your assistance!!!!

 

[mumps]

You are very welcome.

 

[Alaa mg]

@mumps I search for macro like this but my problem is the duplicated items are not arranged consecutively

the original data in col A,B and the result in col G,H with put the formatting and borders and colors and put the data in cell center .
note: the code should create whole data with headers in COL G,H

can you mod the code , please ?

sum dupد.xlsm
	A	B	C	D	E	F	G	H
1	id	va					id	va
2	AA-100	10					AA-100	10
3	AA-100	5					AA-100	5
4	AA-101	10					AA-100	20
5	AA-100	20					SUM	35
6	AA-101	5					AA-101	10
7	AA-102	10					AA-101	5
8	AA-103	20					AA-101	5
9	AA-102	20					SUM	20
10	AA-103	10					AA-102	10
11	AA-101	5					AA-102	20
12	AA-104	5					SUM	30
13							AA-104	5
14							SUM	5
15
16
17
sheet1

thanks in advance

 

[mumps]

This macro will place the result in Sheet2.

Sub SumValues()
    Application.ScreenUpdating = False
    Dim lRow As Long, i As Long, v As Variant, va As Range, total As Long, desWS As Worksheet
    lRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Set desWS = Sheets("Sheet2")
    v = Range("A2", Range("A" & Rows.Count).End(xlUp)).Value
    With desWS.Range("A1:B1")
        .Value = Array("id", "va")
        .Font.Bold = True
    End With
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(v, 1)
            If Not .Exists(v(i, 1)) Then
                .Add v(i, 1), Nothing
                With Range("A1")
                    .CurrentRegion.AutoFilter 1, v(i, 1)
                    For Each va In Range("B2:B" & lRow).SpecialCells(xlCellTypeVisible)
                        total = total + va.Value
                    Next va
                    With desWS
                        Range("A2:B" & lRow).SpecialCells(xlCellTypeVisible).Copy .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
                        .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Interior.ColorIndex = 6
                        .Cells(.Rows.Count, "B").End(xlUp).Offset(1).Interior.ColorIndex = 3
                        With .Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(, 2)
                            .Value = Array("Sum", total)
                            .Font.Bold = True
                            .Borders.LineStyle = xlContinuous
                        End With
                    End With
                End With
                total = 0
            End If
        Next i
        Range("A1").AutoFilter
    End With
    Application.ScreenUpdating = True
End Sub

 

[Alaa mg]

@mumps it gives error 'object variable or with block variable not set " in this line
lRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

 

[mumps]

Make sure that the sheet containing the data is the active sheet.

 

[Alaa mg]

actually I did it , but does not success

 

[mumps]

I tested the macro in a dummy file using the data you posted and it worked properly. Could upload a copy of your file (de-sensitized if necessary) to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here.