Delete duplicates - Problem

  • Thread starter Thread starter Les Stout
  • Start date Start date
L

Les Stout

Hi all, i have the following senario, i need to delete the duplicates
(Entire.Row) in column "A" but keeping the highest number in "B", as
indicated below.

A B

6771879 1 '<== Delete Row
6771879 2 '<== Delete Row
6771879 3 '<== Keep - duplicate but highest Nr in "B".
6774875 10 '<== Keep - Not duplicate in "A"
6775869 1 '>== Keep - Not duplicate in "A"
6775970 1 '<== Delete Row
6775970 2 '<== Keep - duplicate but highest Nr in "B".
6775971 10 '>== Keep - Not duplicate in "A"
6775975 12 '<== Delete Row
6775975 13 '<== Delete Row
6775975 14 '<== Keep - duplicate but highest Nr in "B".

I have the code below from Tom Ogilvy, but it is only keeping the
highest in "B" !!

Sub DeleteLcsDuplicates()
'
'------ With this i need to delete duplicate part numbers in "A" but --
'------ The lowest number in "B".
'------ This assumes you want to retain the part number with the highest
number in column B.
Dim iLastRow As Long
Dim i As Long, rng As Range
Dim rng1 As Range, s As String
Dim maxNum As Long
Set rng = Cells(Rows.Count, 1).End(xlUp)
iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = iLastRow To 2 Step -1
Set rng1 = Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
If Application.CountIf(rng1, Cells(i, 1)) > 1 Then
s = "Max(if(" & rng1.Address & "=" & Cells(i, 1).Address _
& "," & rng1.Offset(0, 1).Address & "))"
maxNum = Evaluate(s)
' Debug.Print i, Cells(i, 1), Cells(i, 2), maxNum
'---- If you want to retain the part with the smallest number, change
MAX to MIN
End If
If Cells(i, 2) < maxNum Then
Rows(i).Delete
End If
Next i
PctDone = Counter + 0.5 '---1
Call UpdateProgress(PctDone)
MoveCompFileToArchive
End Sub



Best regards,

Les Stout
 
Les,

You have an End If in the wrong place.

Change:

If Application.CountIf(rng1, Cells(i, 1)) > 1 Then
s = "Max(if(" & rng1.Address & "=" & Cells(i, 1).Address _
& "," & rng1.Offset(0, 1).Address & "))"
maxNum = Evaluate(s)
' Debug.Print i, Cells(i, 1), Cells(i, 2), maxNum
'---- If you want to retain the part with the smallest number, change
' MAX to MIN
End If
If Cells(i, 2) < maxNum Then
Rows(i).Delete
End If

To

If Application.CountIf(rng1, Cells(i, 1)) > 1 Then
s = "Max(if(" & rng1.Address & "=" & Cells(i, 1).Address _
& "," & rng1.Offset(0, 1).Address & "))"
maxNum = Evaluate(s)
' Debug.Print i, Cells(i, 1), Cells(i, 2), maxNum
'---- If you want to retain the part with the smallest number, change
'---- MAX to MIN
If Cells(i, 2) < maxNum Then
Rows(i).Delete
End If
End If


HTH,
Bernie
MS Excel MVP
 
Thank you for your reply Bernie, but unfortunately that does not solve
my initial problem...

Best regards,

Les Stout
 
Are there not any more GURUS prepared to give this a bash PLease ??
quite desperate... :-0)

Best regards,

Les Stout
 
Please do not worry, i have solved the problem by resetting the Variable
"maxNum" to 0 after deleting the row, that way when it gets to a
duplicate then it keeps the highest number in "B"...

Best regards,

Les Stout
 
Les,

You're mistaken.

This code:

Sub DeleteLcsDuplicates()
Dim iLastRow As Long
Dim i As Long, rng As Range
Dim rng1 As Range, s As String
Dim maxNum As Long
Set rng = Cells(Rows.Count, 1).End(xlUp)
iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = iLastRow To 2 Step -1
Set rng1 = Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
If Application.CountIf(rng1, Cells(i, 1)) > 1 Then
s = "Max(if(" & rng1.Address & "=" & Cells(i, 1).Address _
& "," & rng1.Offset(0, 1).Address & "))"
maxNum = Evaluate(s)
If Cells(i, 2) < maxNum Then
Rows(i).Delete
End If
End If
Next i
End Sub

Which contains the change that I indicated to you, changed this table:

Code Value
6771879 1 '<== Delete Row
6771879 2 '<== Delete Row
6771879 3 '<== Keep - duplicate but highest Nr in "B".
6774875 10 '<== Keep - Not duplicate in "A"
6775869 1 '>== Keep - Not duplicate in "A"
6775970 1 '<== Delete Row
6775970 2 '<== Keep - duplicate but highest Nr in "B".
6775971 10 '>== Keep - Not duplicate in "A"
6775975 12 '<== Delete Row
6775975 13 '<== Delete Row
6775975 14 '<== Keep - duplicate but highest Nr in "B".


To this

Code Value
6771879 3 '<== Keep - duplicate but highest Nr in "B".
6774875 10 '<== Keep - Not duplicate in "A"
6775869 1 '>== Keep - Not duplicate in "A"
6775970 2 '<== Keep - duplicate but highest Nr in "B".
6775971 10 '>== Keep - Not duplicate in "A"
6775975 14 '<== Keep - duplicate but highest Nr in "B".

Which was exactly what you requested. The only assumption in the code that I kept was that Row 1
had headers, and the data started in Row 2.

HTH,
Bernie
MS Excel MVP
 
Hi Bernie, my HUMBLE apologies...:0) It works perfectly, thank you so
much...

Best regards,

Les Stout
 
Back
Top