# Find Duplicate Values, Sum Amount, Keep Most recent Row

#### kentster

##### New Member
Hi - I am using Excel 2013. I have tried Consolidated Data but it just adds the dates.

I have created the "Beginning" and "End" tables below as an example. Is it possible to have a VBA code that accomplishes this? Starting with the Beginning table, find the duplicated values in Column 1. From there, add the values in Column 3 for those duplicate rows. Then find the row from those duplicate rows which has the most recent date and keep that row.

The end result is the End table. One row for each of the duplicates which has the summed value, and the most recent date (all other data would simply flow from the row selected with the most recent date). I hope that made sense.

See Below:

 Beginning Opp+Lvl6 SaaS Opp # Amount Level 6 Level 7 Is it in SW Fcst Date Updated A1 A 10 1 A Y 1/3/2016 B1 B 20 1 A Y 5/1/2016 B1 C 30 1 A Y 10/5/2016 C2 C 10 2 A Y 11/1/2016 A1 A 100 1 A Y 5/5/2015 D1 D 10 1 A Y 11/1/2016

<tbody>
</tbody>

 End result after Macro Opp+Lvl6 SaaS Opp # Amount Level 6 Level 7 Is it in SW Fcst Date Updated A1 A 110 1 A Y 1/3/2016 B1 C 50 1 A Y 10/5/2016 C2 C 10 2 A Y 11/1/2016 D1 D 10 1 A Y 11/1/2016

<tbody>
</tbody>

I appreciate everyone's assistance here. I will keep trying with the hopes this can be figured out.

### Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December
Give this a try on a copy of your file.

Code:
``````Sub t()
Dim i As Long, lr As Long, fn As Range, fAdr As String
With ActiveSheet
lr = .Cells(Rows.Count, 1).End(xlUp).Row
For i = lr To 3 Step -1
If Application.CountIf(.Range("A:A"), .Cells(i, 1).Value) > 1 Then
Set fn = .Range("A1:A" & i).Find(.Cells(i, 1).Value, , xlValues, xlWhole)
If Not fn Is Nothing Then
Do
fn.Offset(, 2) = fn.Offset(, 2).Value + .Cells(i, 3).Value
If fn.Offset(, 6).Value < .Cells(i, 7).Value Then
fn.Offset(, 6) = .Cells(i, 7).Value
End If
Set fn = .Range("A2:A" & i).FindNext(fn)
Rows(i).Delete
End If
End If
Next
End With
End Sub``````

Hi - Thanks. One little snag it appears. I tried it out on my data below, and it looks like it is adding D2+D3+D4 for the duplicate value of XXX1, instead of D2+D4+D7. The sum of the values for A1 duplicates is showing 220 with the code you had provided when it should be 210. It was correct for BBB2. I tried a sort in the code before I ran your code, but it was the same result. Below is a snapshot of how my data could look before running the macro.

 Row B C D E F G H 2 XXX1 XXX 100 1 A A 10/5/2016 3 B1 B 20 1 A - 5/1/2016 4 XXX1 XXX 100 1 A A 11/1/2016 5 C3 C 20 3 A A 7/5/2016 6 C4 C 30 4 A A 8/15/2016 7 XXX1 XXX 10 1 A A 9/3/2016 8 D2 D 20 2 A A 9/23/2016 9 F1 F 10 1 A A 3/4/2016 10 BBB2 BBB 50 2 A A 10/5/2016 11 BBB2 BBB 10 2 A A 10/7/2016 12 G1 G 20 1 A - 11/23/2016 13 H2 H 10 2 A - 12/1/2016 14 I1 I 20 1 A - 8/5/2016

<colgroup><col span="7"><col></colgroup><tbody>
</tbody>

I appreciate the assist!

Possibly, another option:-
Code:
``````[COLOR="Navy"]Sub[/COLOR] MG05Dec13
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Q [COLOR="Navy"]As[/COLOR] Variant, DK [COLOR="Navy"]As[/COLOR] Variant, nRng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("B2"), Range("B" & Rows.Count).End(xlUp))
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
[COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
[COLOR="Navy"]Else[/COLOR]
[COLOR="Navy"]If[/COLOR] Dn.Offset(, 6).Value > .Item(Dn.Value).Offset(, 6).Value [COLOR="Navy"]Then[/COLOR]
[COLOR="Navy"]Set[/COLOR] .Item(Dn.Value) = Dn
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
.Item(Dn.Value).Offset(, 2).Value = .Item(Dn.Value).Offset(, 2).Value + Dn.Offset(, 2).Value
[COLOR="Navy"]If[/COLOR] nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Set[/COLOR] nRng = Dn Else [COLOR="Navy"]Set[/COLOR] nRng = Union(nRng, Dn)
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]If[/COLOR] Not nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] nRng.EntireRow.Delete
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]``````
Regards Mick

EUREKA! I messed around with multiple examples whic had significant rows of data and I just modified your code to find the right columns and all worked out perfectly! Awesome stuff! Thank you so much!

EUREKA! I messed around with multiple examples whic had significant rows of data and I just modified your code to find the right columns and all worked out perfectly! Awesome stuff! Thank you so much!

here is what I finally arrived at.

Code:
``````Sub t()
Dim i As Long, lr As Long, fn As Range, fAdr As String, dRw As Long
With ActiveSheet
lr = .Cells(Rows.Count, 1).End(xlUp).Row
For i = lr To 3 Step -1
If Application.CountIf(.Range("A:A"), .Cells(i, 1).Value) > 1 Then
Set fn = .Range("A1:A" & i).Find(.Cells(i, 1).Value, , xlValues, xlWhole)
If Not fn Is Nothing Then
Do
Range(fAdr).Offset(, 2) = fn.Offset(, 2).Value + .Cells(i, 3).Value
If fn.Offset(, 6).Value < .Cells(i, 7).Value Then
End If
Rows(i).Delete
Else
If Range(fAdr).Offset(, 6).Value < fn.Offset(, 6).Value Then
End If
dRw = fn.Row
End If
Set fn = .Range("A2:A" & i - 1).FindNext(fn)
If Not IsEmpty(dRw) Then
.Rows(dRw).Delete
dRw = Empty
End If
End If
End If
Next
End With
End Sub``````

Last edited:

Replies
10
Views
340
Replies
14
Views
1K
Replies
5
Views
269
Replies
7
Views
91
Replies
3
Views
232

1,211,434
Messages
6,101,812
Members
447,758
Latest member

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back