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 ***

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" <(E-Mail Removed)> wrote in message news:OIg$(E-Mail Removed)...
> 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 ***

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 ***

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 ***

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 ***

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" <(E-Mail Removed)> wrote in message news:O%23$(E-Mail Removed)...
> 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 ***

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

Best regards,

Les Stout

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