Formula to identify / remove duplicates based on one column

Mr2017

Well-known Member
Joined
Nov 28, 2016
Messages
644
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Hi

I've got three groups of data over 9 rows.

Each group has duplicates and I'd like to delete the duplicate rows based on data in column C, which has Cash Sales.

In the table below,
column A has Product IDs,
column B has Product Names,
column C has Cash Sales and
column D has the Group ID

If a duplicate row is in the data, as is the case with rows 2 and 3, I would like to delete the row where the Cash Sales in column C are either greater OR equal to the other row where there is a duplicate Product ID.

So with rows 2 and 3, row 2 would be deleted because the Cash Sales in column C for row 2 are 100.

Whilst the Cash Sales in column C for the same product in row 3 are 50.

Has anyone done this before? Any thoughts would be greatly appreciated! TIA

[TABLE="width: 470"]
<colgroup><col><col><col><col></colgroup><tbody>[TR]
[TD]Product ID[/TD]
[TD]Product Name[/TD]
[TD]Cash Sales[/TD]
[TD]Group ID[/TD]
[/TR]
[TR]
[TD]1234[/TD]
[TD]Nice Marmalade 70g[/TD]
[TD]100[/TD]
[TD]1234[/TD]
[/TR]
[TR]
[TD]1234[/TD]
[TD]Nice Marmalade 70g[/TD]
[TD]50[/TD]
[TD]1234[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Nice Jam 70g[/TD]
[TD]0[/TD]
[TD]1234[/TD]
[/TR]
[TR]
[TD]5678[/TD]
[TD]Cool Strawberry Juice 50ml[/TD]
[TD]200[/TD]
[TD]5678[/TD]
[/TR]
[TR]
[TD]5678[/TD]
[TD]Cool Strawberry Juice 50ml[/TD]
[TD]100[/TD]
[TD]5678[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]Cool Orange Juice 50ml[/TD]
[TD]0[/TD]
[TD]5678[/TD]
[/TR]
[TR]
[TD]2345[/TD]
[TD]Great Raspberry 70ml[/TD]
[TD]500[/TD]
[TD]2345[/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD]Great Grapefruit 70ml[/TD]
[TD]0[/TD]
[TD]2345[/TD]
[/TR]
[TR]
[TD]2345[/TD]
[TD]Great Raspberry 70ml[/TD]
[TD]500[/TD]
[TD]2345[/TD]
[/TR]
</tbody>[/TABLE]
 
Excellent!!

That also worked like Magic - thank you!!
 
Upvote 0

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce
You're welcome & thanks for the feedback
 
Upvote 0
This can also be done using pivot tables by putting the product id under row labels and the cash value under sum values set to max (go to value field settings by clicking on the arrow of sum values.)
 
Upvote 0
Hi Fluff

This code works, as expected, which is great!

However, do you know how I should modify it if the Product ID starts in C2 rather than A2, and the Cash Sales start in P2 (rather than B2)?

I've done this:

Code:
Sub RD()


   Dim Cl As Range, Rng As Range
   Dim WS As Worksheet
   
   With CreateObject("scripting.dictionary")
      For Each WS In Worksheets
         For Each Cl In WS.Range("c2", WS.Range("c" & Rows.Count).End(xlUp))
            If Not .Exists(Cl.Value) Then
               .Add Cl.Value, Cl.Offset(, 14)
            ElseIf Cl.Offset(, 14).Value < .Item(Cl.Value).Value Then
               If Rng Is Nothing Then Set Rng = .Item(Cl.Value) Else Set Rng = Union(Rng, .Item(Cl.Value))
               Set .Item(Cl.Value) = Cl.Offset(, 14)
            Else
               If Rng Is Nothing Then Set Rng = Cl.Offset(, 14) Else Set Rng = Union(Rng, Cl.Offset(, 14))
            End If
         Next Cl
         If Not Rng Is Nothing Then Rng.EntireRow.Delete
         Set Rng = Nothing
         .RemoveAll
      Next WS
   End With
End Sub

However, in one of the files, I get a "Run time error '13': Type mis-match"

And the line the debug button leads to is this one:

ElseIf Cl.Offset(, 14).Value < .Item(Cl.Value).Value Then

Thanks in advance.
 
Upvote 0
Check the value in both cells when you get the error.
Chances are you ether have text instead of a number in col P, or you have an error such as #N/A in one of the cells
 
Upvote 0
Hi Fluff

You were right!

There was a sheet which had #REF ! errors because some tabs were deleted.

When the #REF ! errors were removed from the columns you suggested, then the code continued to work!

The only other question I have is this: How I can I can exclude certain Sheets from having the macro run on them?

I've tried to add this IF statement to exclude the code running on the tabs with the Summary and Comments, but the exclusions didn't work?

Is there something I've missed?

TIA

For convenience, the lines I added were

For Each sht In ThisWorkbook.Worksheets

If sht.Name <> "Summary" And sht.Name <> "Comments" Then

...*original code*

End if


Code:
Sub RD()


   Dim Cl As Range, Rng As Range
   Dim Ws As Worksheet
   
   For Each sht In ThisWorkbook.Worksheets
    
        If sht.Name <> "Summary" And sht.Name <> "Comments" Then
   
   With CreateObject("scripting.dictionary")
      For Each Ws In Worksheets
         For Each Cl In Ws.Range("c2", Ws.Range("c" & Rows.Count).End(xlUp))
            If Not .Exists(Cl.Value) Then
               .Add Cl.Value, Cl.Offset(, 13)
            ElseIf Cl.Offset(, 13).Value < .Item(Cl.Value).Value Then
               If Rng Is Nothing Then Set Rng = .Item(Cl.Value) Else Set Rng = Union(Rng, .Item(Cl.Value))
               Set .Item(Cl.Value) = Cl.Offset(, 13)
            Else
               If Rng Is Nothing Then Set Rng = Cl.Offset(, 13) Else Set Rng = Union(Rng, Cl.Offset(, 13))
            End If
         Next Cl
         If Not Rng Is Nothing Then Rng.EntireRow.Delete
         Set Rng = Nothing
         .RemoveAll
      Next Ws
   End With
   
        End If
    Next


Exit Sub
 
Upvote 0
It needs to be like
Code:
Sub RD()


   Dim Cl As Range, Rng As Range
   Dim WS As Worksheet
   
   With CreateObject("scripting.dictionary")
      For Each WS In Worksheets
         If WS.Name <> "Summary" And WS.Name <> "Comments" Then
            For Each Cl In WS.Range("c2", WS.Range("c" & Rows.Count).End(xlUp))
               If Not .Exists(Cl.Value) Then
                  .Add Cl.Value, Cl.Offset(, 14)
               ElseIf Cl.Offset(, 14).Value < .Item(Cl.Value).Value Then
                  If Rng Is Nothing Then Set Rng = .Item(Cl.Value) Else Set Rng = Union(Rng, .Item(Cl.Value))
                  Set .Item(Cl.Value) = Cl.Offset(, 14)
               Else
                  If Rng Is Nothing Then Set Rng = Cl.Offset(, 14) Else Set Rng = Union(Rng, Cl.Offset(, 14))
               End If
            Next Cl
            If Not Rng Is Nothing Then Rng.EntireRow.Delete
            Set Rng = Nothing
            .RemoveAll
         Next WS
      End If
   End With
End Sub
 
Upvote 0
Ok, thanks.

When I try to run this, I get a Compile error that says "Next without for."

Do you know where the "for" could be missing, please?
 
Upvote 0
The Next & End if are the wrong way round, it should be
Code:
            .RemoveAll
         End If
      Next WS
   End With
 
Upvote 0

Forum statistics

Threads
1,223,903
Messages
6,175,289
Members
452,631
Latest member
a_potato

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.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

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

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

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
Back
Top