Excel VBA Merge Duplicate rows and sum values in certain column

Question

my data is as below: Sample Data:

A B C Result:
DG M 1 DG M 5
DG M 2 KH M 9
DG M 2 SG C 7
KH M 4 KH M 5
KH M 5 DG M 5
SG C 6
SG C 1
KH M 3
KH M 2
DG M 5

I got 3 column here, and I wish to sum up the value if rows in column A and B is the same with previous row.

Below is the code I refer from other. But the code seem to have only one criteria, I would like to seek a way to add another criteria.Thank you.

Sub MG()

Dim Rng As Range, Dn As Range, n As Double, nRng As Range 

Set Rng = Worksheets("sheet1").Range(Range("B2"), Range("B" & Rows.Count).End(xlUp))

With CreateObject("scripting.dictionary")

.CompareMode = vbTextCompare

For Each Dn In Rng

If Not .Exists(Dn.Value) Then
.Add Dn.Value, Dn

Else

If nRng Is Nothing Then Set nRng = Dn Else Set nRng = Union(nRng, Dn)
.Item(Dn.Value).Offset(, 3) = .Item(Dn.Value).Offset(, 3) + Dn.Offset(, 3)

End If

Next

If Not nRng Is Nothing Then nRng.EntireRow.Delete

End With
End Sub

SJR · Accepted Answer · 2019-05-09 17:04:55Z

2

Here's a different approach:

Sub MG()

Dim Rng As Range, n As Double, j As Long

j = 2: Set Rng = Worksheets("sheet1").Range("A2")

Do While Len(Rng) > 0
    Do
        n = n + Rng.Offset(, 2).Value
        Set Rng = Rng.Offset(1)
    Loop While Rng.Row = 2 Or Rng.Value = Rng.Offset(-1).Value And Rng.Offset(-1, 1).Value = Rng.Offset(-1, 1).Value
    Cells(j, "E") = Rng.Offset(-1).Value
    Cells(j, "F") = Rng.Offset(-1, 1).Value
    Cells(j, "G") = n
    n = 0: j = j + 1
Loop

End Sub

answered May 9, 2019 at 17:04

SJR

23.1k6 gold badges21 silver badges26 bronze badges

Sign up to request clarification or add additional context in comments.

3 Comments

GMalc Over a year ago

@SJR, since the OP is trying to sum the values from all the rows that match Col A and Col B; I suggest sorting the range first to provide an accurate result.

SJR Over a year ago

@GMalc - the OP only wants the contiguous blocks summed, e.g. the last row DG/M is summed separately.

GMalc Over a year ago

Copy, I was reading not looking at the results required. btw +1

YasserKhalil · Accepted Answer · 2019-05-10 09:55:32Z

0

Try this

Sub Test()
Dim a, ws As Worksheet, dic As Object, s As String, i As Long

Set ws = ThisWorkbook.Sheets("Sheet1")
Set dic = CreateObject("scripting.dictionary")
a = ws.Range("A2:C" & ws.Cells(Rows.Count, 1).End(xlUp).Row).Value

For i = LBound(a, 1) To UBound(a, 1)
    s = a(i, 1) & vbTab & a(i, 2)
    If Not dic.Exists(s) Then dic(s) = Array(, , 0)
    dic(s) = Array(a(i, 1), a(i, 2), dic(s)(2) + a(i, 3))
Next i

ws.Range("E2").Resize(dic.Count, 3).Value = Application.Transpose(Application.Transpose(dic.items))
End Sub

answered May 10, 2019 at 9:55

YasserKhalil

9,60813 gold badges62 silver badges135 bronze badges

Collectives™ on Stack Overflow

Excel VBA Merge Duplicate rows and sum values in certain column

2 Answers 2

3 Comments

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

3 Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Related