Delete duplicates - Problem
 

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

*** Sent via Developersdex http://www.developersdex.com ***

Delete duplicates - Problem
 

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


"Les Stout" wrote in message ...
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

*** Sent via Developersdex http://www.developersdex.com ***

Delete duplicates - Problem
 

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

Best regards,

Les Stout

*** Sent via Developersdex http://www.developersdex.com ***

Delete duplicates - Problem
 

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

Best regards,

Les Stout

*** Sent via Developersdex http://www.developersdex.com ***

Delete duplicates - Problem
 

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

*** Sent via Developersdex http://www.developersdex.com ***

Delete duplicates - Problem
 

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


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

Best regards,

Les Stout

*** Sent via Developersdex http://www.developersdex.com ***

Delete duplicates - Problem
 

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

Best regards,

Les Stout

*** Sent via Developersdex http://www.developersdex.com ***