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

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 =)