Macro to remove duplicates base on other cell's valud

allgonzo

New Member
Joined
Jul 25, 2010
Messages
32
I am looking for a macro that will look for duplicates in a specific column then delete the duplicate if it meets the criteria of a separate column. So for example, column a has names, column b has numbers. Column c has specifics values that need to be check in order before deleting the rows in column b.

For example this is the beginning sheet

bob, 1, (0)
bob, 1, (-1)
tom, 2, (0)
tom, 2, (-1)
rick, 1, (-1)
rick, 1, (-2)

I want the macro to come up with

bob, 1, (0)
tom, 2, (0)
rick, 1, (-1)

Essentially deleting rows if its a duplicate in column b and if column c has the highest number. I hope this made sense. Thanks in advance for any suggestions.
 

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.
Try this:
Code:
Option Explicit

Sub RemoveLowerDupes()
Dim LR As Long

LR = Range("A" & Rows.Count).End(xlUp).Row

    Columns("A:C").Sort Key1:=Range("A1"), Order1:=xlAscending, _
                        Key2:=Range("B1"), Order2:=xlAscending, _
                        Key3:=Range("C1"), Order3:=xlDescending, _
                        Header:=xlGuess, OrderCustom:=1, _
                        MatchCase:=False, Orientation:=xlTopToBottom, _
                        DataOption1:=xlSortNormal, _
                        DataOption2:=xlSortNormal, _
                        DataOption3:=xlSortNormal
    
    With Range("D2:D" & LR)
        .FormulaR1C1 = "=IF(AND(RC1=R[-1]C1,RC2=R[-1]C2), ""x"", 1)"
        .SpecialCells(xlCellTypeFormulas, 2).EntireRow.Delete xlShiftUp
        .ClearContents
    End With

End Sub
 
Upvote 0
Thanks for the quick response. When I ran the macro, the end result was:

bob, 1, (0)
rick, 1, (-2)
tom, 1, (-1)

I was hoping for
bob, 1, (0)
rick, 1, (-1)
tom, 1, (0).

I need the macro to delete a duplicate only if its the lowest number on column C. This is a great start. thanks in advance for any assistance.
 
Upvote 0
Excel Workbook
ABC
1bob10
2bob1-1
3tom20
4tom2-1
5rick1-1
6rick1-2
BEFORE
Excel Workbook
ABC
1bob10
2rick1-1
3tom20
AFTER


It works for me perfectly. Maybe your 3rd column isn't really all numeric values? Those parentheses need to "not really there", rather there based on the cell formatting.
 
Upvote 0
Now that I applied the macro to a real life example, I realized I did not explain the situation properly. I apologize for my error. The macro worked wonderfully, it deleted too many rows. example below:

Start

bob, 45, 0
bob, 45, -1
bob, 45, -2
bob, 50, -1
bob, 50, -2
bob, 50, -3

End

bob, 45, 0
bob, 50, -1


Start with 3-4 duplicates in column B. The end result is to delete the duplicates in column b, based on the lowest number on column c, but not delete any duplicates in column a.

I hope this makes sense. Again, truly appreciate the assistance.
 
Upvote 0
On the data you provided, the macro performed properly:
Excel Workbook
ABC
1bob450
2bob45-1
3bob45-2
4bob50-1
5bob50-2
6bob50-3
BEFORE
Excel Workbook
ABC
1bob450
2bob50-1
3
4
5
AFTER
 
Upvote 0
Real life I have 18 columns (A to R). Row one is the header (column names). Column D has the names, Column H has the number and Column N has the 0, -1, -2. I used the macro above and changed the columns to fit this example, but when I ran it, it only leaves one of the names regardless of the number. What I am looking for is for the Macro to delete any duplicates rows that has the same number (H) and the same name (D) based on the highest number on Column N (0 or -1). If the rows contain the same information in columns D, H and N, then it only leaves one row. I tried to alter the macro above to meet the criteria but I am missing something. I appreciate any thoughts. Sorry for multiple postings on the same question.
 
Upvote 0
Try this:
Code:
Option Explicit

Sub RemoveLowerDupes()
Dim LR As Long

LR = Range("D" & Rows.Count).End(xlUp).Row

    Columns("A:Z").Sort Key1:=Range("D2"), Order1:=xlAscending, _
                        Key2:=Range("H2"), Order2:=xlAscending, _
                        Key3:=Range("N2"), Order3:=xlDescending, _
                        Header:=xlYes, OrderCustom:=1, _
                        MatchCase:=False, Orientation:=xlTopToBottom, _
                        DataOption1:=xlSortNormal, _
                        DataOption2:=xlSortNormal, _
                        DataOption3:=xlSortNormal
    
    With Range("AA2:AA" & LR)
        .FormulaR1C1 = "=IF(AND(RC4=R[-1]C4,RC8=R[-1]C8), ""x"", 1)"
        .SpecialCells(xlCellTypeFormulas, 2).EntireRow.Delete xlShiftUp
        .ClearContents
    End With

End Sub
 
Upvote 0

Forum statistics

Threads
1,213,535
Messages
6,114,198
Members
448,554
Latest member
Gleisner2

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