# VBA to Sum and Delete Duplicate Values



## jrjobe (Dec 17, 2022)

Hi All!

I am trying to figure out a way to sum only the values in column B based on all duplicates from column A, then delete all duplicate rows, while retaining rows that do not have a duplicate.  What I initially came up with was from another thread, but after modifying the code, it still leaves the duplicates, but also adds the duplicate names to column C, basically duplicating the name multiple times.  Here is an example of what I'm trying to combine, not all items are duplicates:

***BOM***QuantityDescriptionT/R328779610ELCO EL490ICA 4INIC AT HSNG FOR LED RTFT328779610ELCO EL490ICA 4INIC AT HSNG FOR LED RTFT38718300WIRE NM-B-14/2-CU-WG-2501270410DOTTIE BX1005 BX STAPLE460092910ELCO EL416CT5W 4 IN GIMBAL LED SELECTABLE CCT INSERT328779610ELCO EL490ICA 4INIC AT HSNG FOR LED RTFT38718300WIRE NM-B-14/2-CU-WG-2501270410DOTTIE BX1005 BX STAPLE460092754ELCO EL616CT5W 5/6 IN GIMBAL LED SELECTABLE CCT INSERT333282654ELCO EL570ICA387181620WIRE NM-B-14/2-CU-WG-2501270454DOTTIE BX1005 BX STAPLE430205125NIC DSK43120SWH 9.1W DNL FX 4 AC DISK443538925ALLIED 9351-N 4-IN ROUND OUTLET BOX38718750WIRE NM-B-14/2-CU-WG-2501270425DOTTIE BX1005 BX STAPLE328779625ELCO EL490ICA 4INIC AT HSNG FOR LED RTFT328779625ELCO EL490ICA 4INIC AT HSNG FOR LED RTFT38718750WIRE NM-B-14/2-CU-WG-2501270425DOTTIE BX1005 BX STAPLE4219304245SYL (61404) LEDMD4R/2A/800ST/9SC3/61404387187350WIRE NM-B-14/2-CU-WG-25012704245DOTTIE BX1005 BX STAPLE421930554SYL (61405) LEDMD6R/2A/1200ST/9SC3387181620WIRE NM-B-14/2-CU-WG-2501270454DOTTIE BX1005 BX STAPLE114938428CCHO TP267 4IN RND CEIL PAN NOT FAN RTD38718840WIRE NM-B-14/2-CU-WG-2501270428DOTTIE BX1005 BX STAPLE

Here's the code I am using - probably not the most efficient, so I am definitely open to something else.


```
Sub SumandRemove() 'Excel VBA code to sum rows and remove duplicates.
    Dim ar   As Variant
    Dim i    As Long
    Dim b    As Long
    Dim d    As Long
    Dim str  As String
    Dim Col  As Collection
    
    d = 1
    ar = Sheet5.Cells(2, 1).CurrentRegion.Value
    Set Col = New Collection
    With Col
        For i = 2 To UBound(ar, 1)
            str = ar(i, 1) 'The unique value is in the 1st column
            If Not Exists(Col, str) Then
                d = d + 1
                For b = 1 To UBound(ar, 2)
                    ar(d, b) = ar(i, b)
                Next b
            .Add d, str
            Else
                For b = 2 To UBound(ar, 2) 'the number column is start Column 2
                    ar(.Item(str), b) = ar(.Item(str), b) + ar(i, b)
                Next b
            End If
        Next i
    End With
    Sheet5.Range("A2").Resize(d, UBound(ar, 2)).Value = ar
End Sub

' http://www.vbaexpress.com/forum/showthread.php?26312-Solved-Test-if-an-item-exists-within-a-collection-data-type
Function Exists(Col, ByVal Key As String) As Boolean
    On Error GoTo NotExists
    If VarType(Col.Item(Key)) = vbObject Then
    End If
    Exists = True
    Exit Function
NotExists:
    Exists = False
End Function
```

Thank you for the help!


----------



## alansidman (Dec 17, 2022)

Is this what you are looking for.  You did not show us an expected result so I am guessing at your needs.

***BOM***Total3287796803871813530127044514600929104600927543332826544302051254435389254219304245421930554114938428


----------



## jrjobe (Dec 17, 2022)

I do apologize - I got ahead of myself.  You are on the right track though.  Here is an expected output:

***BOM***QuantityDescriptionT/R328779680ELCO EL490ICA 4INIC AT HSNG FOR LED RTFT3871813530WIRE NM-B-14/2-CU-WG-25012704451DOTTIE BX1005 BX STAPLE460092910ELCO EL416CT5W 4 IN GIMBAL LED SELECTABLE CCT INSERT460092754ELCO EL616CT5W 5/6 IN GIMBAL LED SELECTABLE CCT INSERT333282654ELCO EL570ICA430205125NIC DSK43120SWH 9.1W DNL FX 4 AC DISK443538925ALLIED 9351-N 4-IN ROUND OUTLET BOX4219304245SYL (61404) LEDMD4R/2A/800ST/9SC3/61404421930554SYL (61405) LEDMD6R/2A/1200ST/9SC3114938428CCHO TP267 4IN RND CEIL PAN NOT FAN RTD

All rows without duplicate values would be retained as well as the item description.


----------



## alansidman (Dec 17, 2022)

Power Query
Load your table to PQ Editor

```
let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Removed Columns" = Table.RemoveColumns(Source,{"T/R"}),
    #"Changed Type" = Table.TransformColumnTypes(#"Removed Columns",{{"***BOM***", Int64.Type}, {"Quantity", Int64.Type}, {"Description", type text}}),
    #"Grouped Rows" = Table.Group(#"Changed Type", {"***BOM***"}, {{"Total", each List.Sum([Quantity]), type nullable number}})
in
    #"Grouped Rows"
```

Reload your table as a new query


```
let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Removed Columns" = Table.RemoveColumns(Source,{"T/R"}),
    #"Changed Type" = Table.TransformColumnTypes(#"Removed Columns",{{"***BOM***", Int64.Type}, {"Quantity", Int64.Type}, {"Description", type text}}),
    #"Grouped Rows" = Table.Group(#"Changed Type", {"***BOM***"}, {{"Total", each List.Sum([Quantity]), type nullable number}})
in
    #"Grouped Rows"
```

JOin the two tables


```
let
    Source = Table.NestedJoin(Table1, {"***BOM***"}, #"Table1 (2)", {"***BOM***"}, "Table1 (2)", JoinKind.LeftOuter),
    #"Expanded Table1 (2)" = Table.ExpandTableColumn(Source, "Table1 (2)", {"Description"}, {"Table1 (2).Description"})
in
    #"Expanded Table1 (2)"
```

***BOM***TotalTable1 (2).Description328779680ELCO EL490ICA 4INIC AT HSNG FOR LED RTFT3871813530WIRE NM-B-14/2-CU-WG-25012704451DOTTIE BX1005 BX STAPLE460092910ELCO EL416CT5W 4 IN GIMBAL LED SELECTABLE CCT INSERT460092754ELCO EL616CT5W 5/6 IN GIMBAL LED SELECTABLE CCT INSERT333282654ELCO EL570ICA430205125NIC DSK43120SWH 9.1W DNL FX 4 AC DISK443538925ALLIED 9351-N 4-IN ROUND OUTLET BOX4219304245SYL (61404) LEDMD4R/2A/800ST/9SC3/61404421930554SYL (61405) LEDMD6R/2A/1200ST/9SC3114938428CCHO TP267 4IN RND CEIL PAN NOT FAN RTD


----------



## kevin9999 (Dec 17, 2022)

Another option.

```
Option Explicit
Sub One_Key_Multi_Items()
    Dim rng As Range, r As Range, txt As String
    Dim i As Long, j As Long, n As Long, ws As Worksheet, ar
    Set ws = Worksheets("Sheet5")                           '<<< *** change to actual sheet name ***
    Set rng = ws.Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
    ar = ws.Range("A1").CurrentRegion

    With CreateObject("scripting.dictionary")
        For Each r In rng
            txt = r.Value
            If Not .exists(txt) Then
                n = n + 1
                .Add txt, n
                For j = 1 To UBound(ar, 2)
                    ar(n, j) = r.Offset(, j - 1)
                Next j
            Else
                For i = 2 To UBound(ar, 2)
                    If IsNumeric(ar(.Item(txt), i)) Then
                        ar(.Item(txt), i) = ar(.Item(txt), i) + r.Offset(, i - 1)
                    Else
                        ar(.Item(txt), i) = ar(.Item(txt), i)
                    End If
                Next i
            End If
        Next r
    End With
     
    With ws
        .Range("A1").CurrentRegion.Offset(1).ClearContents
        .Range("A1").Resize(n, 3) = ar
    End With
End Sub
```


----------



## jrjobe (Dec 17, 2022)

Gents, thank you for the help! I am not familiar with PQ and wasn't quite certain how I was going to integrate it.  The VBA code provided by Kevin works like a champ.  I'll compare it to what I tried to see where I went wrong.  I did make a few changes to the code I posted, but still couldn't get the expected output and it kept copying the first row.  I get rusty when I'm not looking at this every day.  

Again, thank you!


----------



## kevin9999 (Dec 17, 2022)

Glad we could help & thanks for the feedback 
It's worth learning Power Query, as you can see Alan's solution requires a lot less code (and is therefore easier to change/maintain).


----------



## Peter_SSs (Dec 18, 2022)

In case it is of any use and depending if order is important, perhaps Excel's built-in Pivot Table feature (used in tabular form) might be worth considering as a manual option?

jrjobe.xlsmABCDEFGH1***BOM***QuantityDescriptionT/R***BOM***DescriptionSum of Quantity2328779610ELCO EL490ICA 4INIC AT HSNG FOR LED RTFT12704DOTTIE BX1005 BX STAPLE4513328779610ELCO EL490ICA 4INIC AT HSNG FOR LED RTFT38718WIRE NM-B-14/2-CU-WG-25013530438718300WIRE NM-B-14/2-CU-WG-2501149384CCHO TP267 4IN RND CEIL PAN NOT FAN RTD2851270410DOTTIE BX1005 BX STAPLE3287796ELCO EL490ICA 4INIC AT HSNG FOR LED RTFT806460092910ELCO EL416CT5W 4 IN GIMBAL LED SELECTABLE CCT INSERT3332826ELCO EL570ICA547328779610ELCO EL490ICA 4INIC AT HSNG FOR LED RTFT4219304SYL (61404) LEDMD4R/2A/800ST/9SC3/61404245838718300WIRE NM-B-14/2-CU-WG-2504219305SYL (61405) LEDMD6R/2A/1200ST/9SC35491270410DOTTIE BX1005 BX STAPLE4302051NIC DSK43120SWH 9.1W DNL FX 4 AC DISK2510460092754ELCO EL616CT5W 5/6 IN GIMBAL LED SELECTABLE CCT INSERT4435389ALLIED 9351-N 4-IN ROUND OUTLET BOX2511333282654ELCO EL570ICA4600927ELCO EL616CT5W 5/6 IN GIMBAL LED SELECTABLE CCT INSERT5412387181620WIRE NM-B-14/2-CU-WG-2504600929ELCO EL416CT5W 4 IN GIMBAL LED SELECTABLE CCT INSERT10131270454DOTTIE BX1005 BX STAPLE14430205125NIC DSK43120SWH 9.1W DNL FX 4 AC DISK15443538925ALLIED 9351-N 4-IN ROUND OUTLET BOX1638718750WIRE NM-B-14/2-CU-WG-250171270425DOTTIE BX1005 BX STAPLE18328779625ELCO EL490ICA 4INIC AT HSNG FOR LED RTFT19328779625ELCO EL490ICA 4INIC AT HSNG FOR LED RTFT2038718750WIRE NM-B-14/2-CU-WG-250211270425DOTTIE BX1005 BX STAPLE224219304245SYL (61404) LEDMD4R/2A/800ST/9SC3/6140423387187350WIRE NM-B-14/2-CU-WG-2502412704245DOTTIE BX1005 BX STAPLE25421930554SYL (61405) LEDMD6R/2A/1200ST/9SC326387181620WIRE NM-B-14/2-CU-WG-250271270454DOTTIE BX1005 BX STAPLE28114938428CCHO TP267 4IN RND CEIL PAN NOT FAN RTD2938718840WIRE NM-B-14/2-CU-WG-250301270428DOTTIE BX1005 BX STAPLEPT


----------



## alansidman (Dec 19, 2022)

FYI

Power Query is a free AddIn for Excel 2010 and 2013, and is built-in functionality from Excel 2016 onwards (where it is referred to as "_Get & Transform Data_").

It is a powerful yet simple way of getting, changing and using data from a broad variety of sources, creating steps which may be easily repeated and refreshed. I strongly recommend learning how to use Power Query - it's among the most powerful functionalities of Excel.

- Follow this link to learn how to install Power Query in Excel 2010 / 2013.

- Follow this link for an introduction to Power Query functionality.

- Follow this link for a video which demonstrates how to use Power Query code provided.


----------



## mohadin (Dec 19, 2022)

Hi
Same as kevein but...

```
Sub test()
Dim a, w
Dim i&
a = Sheets("Sheet5").Cells(1).CurrentRegion
    With CreateObject("scripting.dictionary")
        For i = 1 To UBound(a)
            If a(i, 1) <> "" Then
                If Not .exists(a(i, 1)) Then
                .Add a(i, 1), Array(a(i, 1), a(i, 3), a(i, 2))
                Else
                w = .Item(a(i, 1)): w(2) = w(2) + a(i, 2): .Item(a(i, 1)) = w
                End If
        End If
    Next
Sheets("Sheet5").Cells(1, 5).Resize(.Count, 3) = Application.Index(.items, 0, 0)
End With
End Sub
```


----------



## jrjobe (Dec 17, 2022)

Hi All!

I am trying to figure out a way to sum only the values in column B based on all duplicates from column A, then delete all duplicate rows, while retaining rows that do not have a duplicate.  What I initially came up with was from another thread, but after modifying the code, it still leaves the duplicates, but also adds the duplicate names to column C, basically duplicating the name multiple times.  Here is an example of what I'm trying to combine, not all items are duplicates:

***BOM***QuantityDescriptionT/R328779610ELCO EL490ICA 4INIC AT HSNG FOR LED RTFT328779610ELCO EL490ICA 4INIC AT HSNG FOR LED RTFT38718300WIRE NM-B-14/2-CU-WG-2501270410DOTTIE BX1005 BX STAPLE460092910ELCO EL416CT5W 4 IN GIMBAL LED SELECTABLE CCT INSERT328779610ELCO EL490ICA 4INIC AT HSNG FOR LED RTFT38718300WIRE NM-B-14/2-CU-WG-2501270410DOTTIE BX1005 BX STAPLE460092754ELCO EL616CT5W 5/6 IN GIMBAL LED SELECTABLE CCT INSERT333282654ELCO EL570ICA387181620WIRE NM-B-14/2-CU-WG-2501270454DOTTIE BX1005 BX STAPLE430205125NIC DSK43120SWH 9.1W DNL FX 4 AC DISK443538925ALLIED 9351-N 4-IN ROUND OUTLET BOX38718750WIRE NM-B-14/2-CU-WG-2501270425DOTTIE BX1005 BX STAPLE328779625ELCO EL490ICA 4INIC AT HSNG FOR LED RTFT328779625ELCO EL490ICA 4INIC AT HSNG FOR LED RTFT38718750WIRE NM-B-14/2-CU-WG-2501270425DOTTIE BX1005 BX STAPLE4219304245SYL (61404) LEDMD4R/2A/800ST/9SC3/61404387187350WIRE NM-B-14/2-CU-WG-25012704245DOTTIE BX1005 BX STAPLE421930554SYL (61405) LEDMD6R/2A/1200ST/9SC3387181620WIRE NM-B-14/2-CU-WG-2501270454DOTTIE BX1005 BX STAPLE114938428CCHO TP267 4IN RND CEIL PAN NOT FAN RTD38718840WIRE NM-B-14/2-CU-WG-2501270428DOTTIE BX1005 BX STAPLE

Here's the code I am using - probably not the most efficient, so I am definitely open to something else.


```
Sub SumandRemove() 'Excel VBA code to sum rows and remove duplicates.
    Dim ar   As Variant
    Dim i    As Long
    Dim b    As Long
    Dim d    As Long
    Dim str  As String
    Dim Col  As Collection
    
    d = 1
    ar = Sheet5.Cells(2, 1).CurrentRegion.Value
    Set Col = New Collection
    With Col
        For i = 2 To UBound(ar, 1)
            str = ar(i, 1) 'The unique value is in the 1st column
            If Not Exists(Col, str) Then
                d = d + 1
                For b = 1 To UBound(ar, 2)
                    ar(d, b) = ar(i, b)
                Next b
            .Add d, str
            Else
                For b = 2 To UBound(ar, 2) 'the number column is start Column 2
                    ar(.Item(str), b) = ar(.Item(str), b) + ar(i, b)
                Next b
            End If
        Next i
    End With
    Sheet5.Range("A2").Resize(d, UBound(ar, 2)).Value = ar
End Sub

' http://www.vbaexpress.com/forum/showthread.php?26312-Solved-Test-if-an-item-exists-within-a-collection-data-type
Function Exists(Col, ByVal Key As String) As Boolean
    On Error GoTo NotExists
    If VarType(Col.Item(Key)) = vbObject Then
    End If
    Exists = True
    Exit Function
NotExists:
    Exists = False
End Function
```

Thank you for the help!


----------



## jrjobe (Dec 19, 2022)

Thanks all for the help and I apologize for the late reply!  The reason I haven't used Power Query is that I am far from familiar with it and use quite a bit of VBA tied to a custom menu built using Office RibbonX Editor.  Up until I finally decided to get some assistance, I did use Pivot Tables to do something similar.  It was kind of a pain and not quite as streamlined as clicking a button as I can do with other actions on the workbook.

@alansidman I'll take a deeper look into PQ based on your comments and recommendations by @kevin9999.  I guess it is good to learn something new.

@Peter_SSs - I had been contemplating the order of those numbers as they are item numbers from another worksheet.  The other worksheet has over 70K line items, but the numbers aren't consecutive, yet they are in order.  It's really for internal use only though.  

@mohadin - thanks for this input as well! It works similarly to the Pivot Table - not certain I like it that way though as I do have another button prepped to generate a PDF on this page of the cleaned-up data.  The benefit to this or the Pivot Table is that both allow me to check the items to ensure nothing is missing.  Although, multiple runs of various data, show nothing is missing and is combining as it should.  I'll keep this in the workbook in case we run into a problem and need to start double-checking the data.

Again, I can't thank y'all enough!


----------



## alansidman (Dec 19, 2022)

Thanks for the feedback


----------

