Identify columns, add quantites, delete duplicates

Question

I'm working on compiling BOM's for electrical equipment. I've got a total of 18 BOMS with about 160 items each. I'm looking for a code that will scan through all of the data and identify duplicates, take their values, add them up, then delete the duplicates. This code I have identifies and deletes but I cant get it to add up the quantities...

    Sub RemoveDuplicates()

    Dim lastrow As Long

    lastrow = Cells(Rows.Count, "B").End(xlUp).Row

    For x = lastrow To 1 Step -1
        For y = 1 To lastrow
            If Cells(x, 1).Value = Cells(y, 1).Value And Cells(x, 2).Value = Cells(y, 2).Value And x > y Then
                Cells(y, 3).Value = Cells(x, 3).Value + Cells(y, 3).Value
                Rows(x).EntireRow.Delete
                Exit For
            End If
        Next y
    Next x

End Sub

Can you provide some sample data which would support your current code as a [mcve]? — Samuel Everson, Jun 12 '21 at 13:19
Conduit - EMT 1" 320... Conduit - EMT 1-1/2" 50....... Conduit - EMT 2" 120...... Conduit - EMT 3" 180 Conduit - EMT 1" 120........ Conduit - EMT 1-1/2" 30..... Conduit - EMT 2" 300.... Conduit - EMT 3" 25.... — Ted, Jun 12 '21 at 13:35
Name of the item would be comlumn A and qty would be column B — Ted, Jun 12 '21 at 13:36

Алексей Р · Answer 1 · 2021-06-12T17:47:44.450

You can use Dictionary object:

Option Explicit

Sub RemoveDuplicates()
    Dim lastRow As Long, x As Long, strval As String, storedRow As Long
    Dim toDel As Range  ' collects rows to delete
    Dim dict As Object  ' Dictionary
    Set dict = CreateObject("Scripting.Dictionary")
    
    With ThisWorkbook.Worksheets("Sheet1") ' replace with your own WB and WS
        lastRow = Cells(Rows.Count, "B").End(xlUp).Row
        For x = 1 To lastRow
            strval = .Cells(x, 1).Text & "|" & .Cells(x, 2).Text    ' make a key
            If dict.Exists(strval) Then ' check if this string value has been encountered before
                storedRow = dict(strval)    'retrieve the saved row number
                .Cells(storedRow, 3) = .Cells(storedRow, 3) + .Cells(x, 3)
                If toDel Is Nothing Then
                    Set toDel = .Cells(x, 1)
                Else
                    Set toDel = Union(.Cells(x, 1), toDel)
                End If
            Else
                dict.Add strval, x    'make the new entry in the Dictionary: key = string, value = row number
            End If
        Next x
        If Not toDel Is Nothing Then toDel.EntireRow.Delete
    End With
End Sub

Before

After

score 0 · Answer 2 · answered Jun 12 '21 at 18:46

0

If you can enter two helper columns or copy the data to other sheet and do so, as shown in the image below, you may not need VBA.

Just enter the formulas, copy it down, paste values and then filter column c and delete rows for more than 1 count.

answered Jun 12 '21 at 18:46

Naresh

2,984
2
9
15

Identify columns, add quantites, delete duplicates

2 Answers2