Excel VBA find duplicates in 1st 2 columns and then sum rows in 3rd & 4th column

Question

I am trying to make a vba code in excel but fail to do so also having hard time to find a solution on internet.

Example:

     A | B | C | D 

1    Z | Y | 1 | 6
2    Z | Y | 2 | 5
3    Y | Z | 3 | 4
4    X | X | 1 | 2
5    P | Z | 4 | 3
6    P | Z | 5 | 2
7    P | Y | 6 | 1

If Column A1 & A2 are same (Duplicates) then
look in B1 & B2
     if B1 & B2 also duplicates then
          C1 + C2  &  D1 + D2
              and delete rows 2 and 6

After Macro:

     A | B | C | D  

1    Z | Y | 3 | 11
2    Y | Z | 3 | 4
3    X | X | 1 | 2
4    P | Z | 9 | 5
5    P | Y | 6 | 1


rows 2 and 6 were deleted

So if column A contains duplicates, in those duplicate rows look in column B and find duplicates there. If duplicates are also in column B then sum rows in col C & D and delete duplicated row...

Sorry for bad explanation...

Thank you very much, Best Regards, Mario

Answer 1

Another similar solution..

Sub test()
Dim i As Integer

i = Range("A65536").End(xlUp).Row

For K = 2 To i + 1
A = Range("A" & K).Value
B = Range("B" & K).Value

aup = Range("A" & (K - 1)).Value
bup = Range("B" & (K - 1)).Value

If A = aup And B = bup Then
Range("C" & K).Value = Range("C" & K).Value + Range("C" & K - 1).Value
Range("D" & K).Value = Range("D" & K).Value + Range("D" & K - 1).Value


Rows(K - 1).Select
Rows(K - 1).Delete
End If

Next

End Sub

Answer 2

The following solution assumes that your data is already sorted by column A in first order, and column B in second order. If not, make sure you do.

Also, if you have triplicates, then you might need to run it again.

Sub MergeRows()

  Dim i As Integer        'Tracks Rows in Original Table
  Dim ii As Integer       'Tracks Rows in New Table
  Dim v As Variant        'Reads all data into array for speed

  v = Range("A1:D7")      'Change According to your needs

  ii = 1

  For i = 1 To UBound(v, 1) - 1
    'Check that A and B are duplicates
    If v(i, 1) = v(i + 1, 1) And v(i, 2) = v(i + 1, 2) Then
        'Sum up columns C and D
        Cells(ii, 3) = v(i, 3) + v(i + 1, 3)
        Cells(ii, 4) = v(i, 4) + v(i + 1, 4)

        Rows(ii + 1).Delete
        ii = ii - 1
    End If

    ii = ii + 1

  Next

End Sub

Answer 3

Or you may try something like this...

Sub SummarizeData()
Dim lr As Long, i As Long
Application.ScreenUpdating = False
lr = Cells(Rows.Count, 1).End(xlUp).Row
For i = lr To 2 Step -1
    If Cells(i, 1) = Cells(i - 1, 1) And Cells(i, 2) = Cells(i - 1, 2) Then
        Cells(i - 1, 3) = Cells(i - 1, 3) + Cells(i, 3)
        Cells(i - 1, 4) = Cells(i - 1, 4) + Cells(i, 4)
        Range("A" & i & ":D" & i).Delete shift:=xlUp
    End If
Next i
Application.ScreenUpdating = True
End Sub

Answer 4

Sub SummarizeData() Dim lr As Long, i As Long Application.ScreenUpdating = False lr = Cells(Rows.Count, 1).End(xlUp).Row For i = lr To 2 Step -1 If Cells(i, 1) = Cells(i - 1, 1) And Cells(i, 2) = Cells(i - 1, 2) Then Cells(i - 1, 3) = Cells(i - 1, 3) + Cells(i, 3) Cells(i - 1, 4) = Cells(i - 1, 4) + Cells(i, 4) Range("A" & i & ":D" & i).Delete shift:=xlUp End If Next i Application.ScreenUpdating = True End Sub

i found this is helpful and when i try to apply the same to my existing, by changing it into Range, it failed.

e.g changing cell A & B from single character to something like below :

 A | B | C | D 

1 010 | ACPT | 1 | 6

2 010 | RJCT | 2 | 5

3 110 | ACPT | 3 | 4

4 011 | RJCT | 1 | 2

5 010 | ACPT | 4 | 3

6 010 | RJCT | 5 | 2

7 110 | ACPT | 6 | 1