Removing rows with ALMOST duplicate entries BUT

[RobbieC]

Hi there, I have a sheet with multiple rows and 5 columns:

A...... B......C......D.....E
DATA MB02 7.25 305 X (remove)<remove<remove< font="">
DATA MB02 9.45 305 X (remove)
<remove< font=""> <remove
DATA MB02 20.00 305 X
DATA MB02 15.00 250 X<remove <remove<="" font=""> (remove)
DATA MB02 27.00 250 X
DATA MB02 40.00 150 X
DATA MB03 7.25 305 X

I need to remove the rows with duplicates in column B & D (305 & 250) BUT leave the row with the largest entry in column C (20.00 & 27.00)

I can remove identical rows using:

Dim MyRange As Range
lastrow = Sheets("DataSheet").Range("A" & Rows.Count).End(xlUp).Row
Set MyRange = Sheets("DataSheet").Range("A1:E" & lastrow)
'remove duplicate rows if filename matches
MyRange.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5)

but I don't know how to the same with looking just at column B and D (both the same) and largest value in column C

If you can point me in the right direction, I'd be most grateful

Thanks</remove></remove
</remove<></remove<remove<>

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG23Jun14
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Delrng [COLOR="Navy"]As[/COLOR] Range, nRng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] txt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("B2"), Range("B" & Rows.Count).End(xlUp))
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    txt = Dn.Value & Dn.Offset(, 2).Value
    [COLOR="Navy"]If[/COLOR] Not .Exists(txt) [COLOR="Navy"]Then[/COLOR]
        .Add txt, Dn.Offset(, 1)
    [COLOR="Navy"]Else[/COLOR]
       [COLOR="Navy"]If[/COLOR] .Item(txt) >= Dn.Offset(, 1) [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]If[/COLOR] nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Set[/COLOR] nRng = Dn.Offset(, 1) Else [COLOR="Navy"]Set[/COLOR] nRng = Union(nRng, Dn.Offset(, 1))
       [COLOR="Navy"]ElseIf[/COLOR] Dn.Offset(, 1).Value >= .Item(txt) [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]If[/COLOR] nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Set[/COLOR] nRng = .Item(txt) Else [COLOR="Navy"]Set[/COLOR] nRng = Union(nRng, .Item(txt))
           [COLOR="Navy"]Set[/COLOR] .Item(txt) = Dn.Offset(, 1)
       [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]If[/COLOR] Not nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] nRng.EntireRow.Delete
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[RobbieC]

Mick, once again you come up trumps mate!

I added a final 'End With' after the last 'Next' statement, but it does exactly what I need it to do!

Thanks again buddy!

Rob

 

[MickG]

You're welcome
Sorry about the "End With":- Typo !!!

 

[RobbieC]

Just a quick one Mick,

Will this only work with numbers that are in columns C & D?

I have a similar page to sort, but in column D, the value is a mix of letters and numbers... or just letters?

ie:

A...... B......C......D.....E
DATA MB02 7.25 CP305 X (remove)<remove<remove< font="" style="color: rgb(51, 51, 51); background-color: rgb(250, 250, 250);">
DATA MB02 9.45 CP305 X (remove)
<remove< font=""><remove
DATA MB02 20.00 CP305 X
DATA MB02 15.00 CP250 X<remove <remove<="" font=""> (remove)
DATA MB02 27.00 CP250 X
DATA MB02 40.00 CP150 X
DATA MB03 7.25 CP305 X</remove></remove
</remove<></remove<remove<>

 

[MickG]

You should be OK with any Data !!

 

[RobbieC]

Thanks Mick!

This will come in very handy for me!

Rob