How to delete duplicates in excel in different situations (VBA)?

Question

I need to sum corresponding values in to the right columns, but also delete duplicates. Here's the deal:

If, for example, I have columns from A to F. If columns A to E are the same with another row, macro deletes the row and saves older one. IF columns A to C are same with another existing row, macro deletes another row and adds those corresponding values from column D and E to the remaining row. Here is an example:

cell1 cell2 cell3 cell4 cell5 cell6
1      1     1     1     1     1
2      2     2     2     2     2
2      2     2     2     2     2
1      1     1     2     2     1
3      3     3     3     3     3

After macro:

cell1  cell2 cell3 cell4 cell5 cell6
1      1     1      3     3     1 
2      2     2      2     2     2
3      3     3      3     3     3 

So now, macro has deleted row 4 (because it has same values on column A to C as row 1 has) an adds corresponding values from columns D and E to row 1. Also, rows 2 and 3 are duplicates from column A to E, so macro deletes row 3.

Here is an example what I have tried (I got help before with sum-problem (from @JvdV) and adding corresponding values in to right ones works, but I don't know, how to remove duplicates correctly..)

Class module:

Public Col1 As Variant
Public Col2 As Variant
Public Col3 As Variant
Public Col4 As Variant
Public Col5 As Variant
Public Col6 As Variant

Module:

Dim x As Long, arr As Variant, lst As Class1
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")

With Sheet1
    x = .Cells(.Rows.Count, 1).End(xlUp).Row
    arr = .Range("A1:F" & x).Value
End With

.Range("A1:F" & x).RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6), Header:=xlYes

For x = LBound(arr) To UBound(arr)
    If Not dict.Exists(arr(x, 1) & "|" & arr(x, 2) & "|" & arr(x, 3)) Then
        Set lst = New Class1
        lst.Col1 = arr(x, 1)
        lst.Col2 = arr(x, 2)
        lst.Col3 = arr(x, 3)
        lst.Col4 = arr(x, 4)
        lst.Col5 = arr(x, 5)
        lst.Col6 = arr(x, 6)
        dict.Add arr(x, 1) & "|" & arr(x, 2) & "|" & arr(x, 3), lst
    Else
        dict(arr(x, 1) & "|" & arr(x, 2) & "|" & arr(x, 3)).Col4 = dict(arr(x, 1) & "|" & arr(x, 2) & "|" & arr(x, 3)).Col4 + arr(x, 4)
        dict(arr(x, 1) & "|" & arr(x, 2) & "|" & arr(x, 3)).Col5 = dict(arr(x, 1) & "|" & arr(x, 2) & "|" & arr(x, 3)).Col5 + arr(x, 5)
    End If
Next x

With Sheet1
    x = 1
    For Each Key In dict.Keys
        .Cells(x, 1).Value = dict(Key).Col1
        .Cells(x, 2).Value = dict(Key).Col2
        .Cells(x, 3).Value = dict(Key).Col3
        .Cells(x, 4).Value = dict(Key).Col4
        .Cells(x, 5).Value = dict(Key).Col5
        .Cells(x, 6).Value = dict(Key).Col6
        x = x + 1
    Next Key
End With

End Sub

Answer 1

Some mistakes in your code, including populating your array before deleting first duplicates and having your RemoveDuplicates outside your With statement and including column F. To make your code work properly you could try the below:

_Before

Sub Test()

Dim x As Long, arr As Variant, lst As Class1
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")

With Sheet1

    'Step one: Delete duplicates over columns A-E
    x = .Cells(.Rows.Count, 1).End(xlUp).Row
    .Range("A1:F" & x).RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5), Header:=xlYes

    'Step two: Populate your array
    x = .Cells(.Rows.Count, 1).End(xlUp).Row
    arr = .Range("A2:F" & x).Value

    'Step three: Clear range
    .Range("A2:F" & x).ClearContents

    'Step Four: Go through your array and populate a dictionary
    For x = LBound(arr) To UBound(arr)
        Set lst = New Class1
        lst.Col1 = arr(x, 1)
        lst.Col2 = arr(x, 2)
        lst.Col3 = arr(x, 3)
        lst.Col4 = arr(x, 4)
        lst.Col5 = arr(x, 5)
        lst.Col6 = arr(x, 6)
        KeyX = Join(Array(arr(x, 1), arr(x, 2), arr(x, 3)), "|")
        If dict.Exists(KeyX) = False Then
            dict.Add KeyX, lst
        Else
            dict(KeyX).Col4 = dict(KeyX).Col4 + arr(x, 4)
            dict(KeyX).Col5 = dict(KeyX).Col5 + arr(x, 5)
        End If
    Next x

    'Step five: Go through your dictionary and write to sheet
    x = 2
    For Each key In dict.Keys
        .Range(.Cells(x, 1), .Cells(x, 6)).Value = Array(dict(key).Col1, dict(key).Col2, dict(key).Col3, dict(key).Col4, dict(key).Col5, dict(key).Col6)
        x = x + 1
    Next key

End With

End Sub

_After

Let me know how it went =)