Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 396
Default 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 ***
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 5,441
Default 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 ***



  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 396
Default 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 ***
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 396
Default 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 ***
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 396
Default 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 ***


  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 5,441
Default 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 ***



  #7   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 396
Default 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 ***
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
delete duplicates DogmaDot Excel Discussion (Misc queries) 1 March 18th 10 10:18 PM
Delete duplicates Angie M. Excel Worksheet Functions 4 February 4th 10 03:56 AM
Delete duplicates? kk Excel Discussion (Misc queries) 2 March 14th 08 02:22 PM
delete duplicates macro to color instead of delete DKY[_90_] Excel Programming 4 December 22nd 05 05:44 PM
delete duplicates delmac Excel Programming 2 July 25th 05 11:57 AM


All times are GMT +1. The time now is 10:02 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"