Find Duplicate Rows across multiple columns, sum dupes to a column, remove duplicates. VBA?

[jrsmoots]

I have a spreadsheet like this:

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]UN[/TD]
[TD]Job[/TD]
[TD]RG[/TD]
[TD]AS[/TD]
[TD]TH[/TD]
[TD]SumDupes[/TD]
[/TR]
[TR]
[TD]L217028[/TD]
[TD]1[/TD]
[TD]B[/TD]
[TD]12[/TD]
[TD]75[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]L217028[/TD]
[TD]1[/TD]
[TD]C[/TD]
[TD]12[/TD]
[TD]50[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]L217028[/TD]
[TD]1[/TD]
[TD]C[/TD]
[TD]12[/TD]
[TD]50[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]L217028[/TD]
[TD]1[/TD]
[TD]C[/TD]
[TD]12[/TD]
[TD]100[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]L217028[/TD]
[TD]2[/TD]
[TD]A[/TD]
[TD]6[/TD]
[TD]50[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

I need to find duplicates: duplicate in this case means that the "Job", "RG" and "AS" are identical. So in above sample the 2nd, 3rd and 4th data rows would be considered duplicates.

I need to then sum the "TH" column for these duplicates. So, 50+50+50.

I then need to remove the duplicates (consolidate?) it down to one row, that row having the total from the duplicates (the 50+50+50).

I'm pretty comfortable with VBA, less comfortable with Excel formulas. Is this procedure something I could do from within Excel, using VBA? Trying to figure out how to present this functionality to the end user too...Maybe they could run a Macro that calls a VBA function?

I try concatenating the three columns that might might be duplicates, and tried the following formulas, which work for finding duplicates

IF(COUNTIF($H$2:H2,H2)>1, " Here I am! I'm a duplicate!","Original")

And summing duplicates:
=IF(AND(COUNTIF(H$2:H2,H2)=COUNTIF(H:H,H2),COUNTIF(H:H,H2)>1),SUMIF(H:H,H2,F:F),"")

from: https://www.mrexcel.com/forum/excel...-then-sum-values-another-column-same-row.html

Thanks in advance!

 

[Fluff]

Hi & welcome to MrExcel.
How about

Sub jrsmoots()
   Dim Cl As Range, Rng As Range
   Dim Vlu As String
   
   With CreateObject("scripting.dictionary")
      For Each Cl In Range("B2", Range("B" & Rows.Count).End(xlUp))
         Vlu = Cl.Value & "|" & Cl.Offset(, 1).Value & "|" & Cl.Offset(, 2).Value
         If Not .exists(Vlu) Then
            .Add Vlu, Cl.Offset(, 3)
         Else
            .Item(Vlu).Value = .Item(Vlu) + Cl.Offset(, 3).Value
            If Rng Is Nothing Then Set Rng = Cl Else Set Rng = Union(Rng, Cl)
         End If
      Next Cl
   End With
   If Not Rng Is Nothing Then Rng.EntireRow.Delete
End Sub

 

[jrsmoots]

Thanks! I will try this out

 

[Cesar31]

Hello,

I need to do the same but instead I have to add and sum one more cell and the end of the row.

Can you please help me??

 

[Fluff]

Hi & welcome to MrExcel.
Please start a new thread for your question. You are far more likely to get a response.