Remove duplicate rows based on column BUT leave last occurence

[knigget]

Hi all,

I have been searching for days (literally) for a macro to help me.
This workbook is written to on a sometimes daily basis - the new data always goes to the next available row.

Search for duplicate project numbers in column A
If project number is duplicated anywhere in column A then delete all those above the lowest positioned match.

If that is double-dutch, perhaps I should explain. Everytime this workbook is written to, the new data goes to the next available row (next one down).
This workbook is used to log the status of various projects so it has various project numbers being logged to it.
Column A is called 'project no' and it could be that that over time, one project number appears on lines 1,13,47,63,78 (for example). I would like for the project number detailed on lines 1,13,47,63 to be deleted and to be left with line 78 which would be the most recent.

Can you help me?

 

[knigget]

An example of the type of data/ goal:

Before
<TABLE style="WIDTH: 299pt; BORDER-COLLAPSE: collapse" border=0 cellSpacing=0 cellPadding=0 width=397 x:str><COLGROUP><COL style="WIDTH: 63pt; mso-width-source: userset; mso-width-alt: 3072" span=2 width=84><COL style="WIDTH: 41pt; mso-width-source: userset; mso-width-alt: 1974" width=54><COL style="WIDTH: 46pt; mso-width-source: userset; mso-width-alt: 2230" width=61><COL style="WIDTH: 86pt; mso-width-source: userset; mso-width-alt: 4169" width=114><TBODY><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; WIDTH: 63pt; HEIGHT: 12.75pt; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8" height=17 width=84 align=right x:num>311111</TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; WIDTH: 63pt; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8" width=84></TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; WIDTH: 41pt; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8" width=54>test unit</TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; WIDTH: 46pt; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8" width=61>customer</TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; WIDTH: 86pt; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8" width=114>test1</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; HEIGHT: 12.75pt; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8" height=17 align=right x:num>344444</TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8"></TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8">test unit</TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8">customer</TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8">test2</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; HEIGHT: 12.75pt; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8" height=17 align=right x:num>311111</TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8"></TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8">test unit</TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8">customer</TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8">test2</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; HEIGHT: 12.75pt; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8" height=17 align=right x:num>344444</TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8"></TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8">test unit</TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8">customer</TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8">test3</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; HEIGHT: 12.75pt; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8" height=17 align=right x:num>311111</TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8"></TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8">test unit</TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8">customer</TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8">test3</TD></TR></TBODY></TABLE>
<TABLE style="WIDTH: 299pt; BORDER-COLLAPSE: collapse" border=0 cellSpacing=0 cellPadding=0 width=397 x:str><COLGROUP><COL style="WIDTH: 63pt; mso-width-source: userset; mso-width-alt: 3072" span=2 width=84><COL style="WIDTH: 41pt; mso-width-source: userset; mso-width-alt: 1974" width=54><COL style="WIDTH: 46pt; mso-width-source: userset; mso-width-alt: 2230" width=61><COL style="WIDTH: 86pt; mso-width-source: userset; mso-width-alt: 4169" width=114><TBODY><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; WIDTH: 63pt; HEIGHT: 12.75pt; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8" height=17 width=84 align=right x:num>344444</TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; WIDTH: 63pt; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8" width=84></TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; WIDTH: 41pt; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8" width=54>test unit</TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; WIDTH: 46pt; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8" width=61>customer</TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; WIDTH: 86pt; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8" width=114>test4</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; HEIGHT: 12.75pt; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8" height=17 align=right x:num>311111</TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8"></TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8">test unit</TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8">customer</TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8">test4</TD></TR></TBODY></TABLE>

and with the magic of macro

<TABLE style="WIDTH: 299pt; BORDER-COLLAPSE: collapse" border=0 cellSpacing=0 cellPadding=0 width=397 x:str><COLGROUP><COL style="WIDTH: 63pt; mso-width-source: userset; mso-width-alt: 3072" span=2 width=84><COL style="WIDTH: 41pt; mso-width-source: userset; mso-width-alt: 1974" width=54><COL style="WIDTH: 46pt; mso-width-source: userset; mso-width-alt: 2230" width=61><COL style="WIDTH: 86pt; mso-width-source: userset; mso-width-alt: 4169" width=114><TBODY><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; WIDTH: 63pt; HEIGHT: 12.75pt; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8" height=17 width=84 align=right x:num>344444</TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; WIDTH: 63pt; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8" width=84></TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; WIDTH: 41pt; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8" width=54>test unit</TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; WIDTH: 46pt; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8" width=61>customer</TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; WIDTH: 86pt; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8" width=114>test4</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; HEIGHT: 12.75pt; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8" height=17 align=right x:num>311111</TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8"></TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8">test unit</TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8">customer</TD><TD style="BORDER-BOTTOM: #d4d0c8; BORDER-LEFT: #d4d0c8; BACKGROUND-COLOR: transparent; BORDER-TOP: #d4d0c8; BORDER-RIGHT: #d4d0c8">test4</TD></TR></TBODY></TABLE>

 

[jeffreybrown]

A few questions...

I take it by your description there is no header row?

and

with line 78 which you want kept, do you want the project number to remain on line 78 or the rows with the duplicates deleted?

and

can the list be sorted?

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG12Aug55
[COLOR="Navy"]Dim[/COLOR] Rng     [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn          [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] nRng    [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Q       [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] K       [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & 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
    [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
        .Add Dn.Value, Array(Nothing, Dn)
    [COLOR="Navy"]Else[/COLOR]
        Q = .item(Dn.Value)
            [COLOR="Navy"]If[/COLOR] Q(0) [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
                [COLOR="Navy"]Set[/COLOR] Q(0) = Q(1)
                [COLOR="Navy"]Set[/COLOR] Q(1) = Dn
            [COLOR="Navy"]Else[/COLOR]
                [COLOR="Navy"]Set[/COLOR] Q(0) = Union(Q(0), Q(1))
                [COLOR="Navy"]Set[/COLOR] Q(1) = Dn
            [COLOR="Navy"]End[/COLOR] If
        .item(Dn.Value) = Q
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
    [COLOR="Navy"]If[/COLOR] Not .item(K)(0) [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]If[/COLOR] nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]Set[/COLOR] nRng = .item(K)(0)
        [COLOR="Navy"]Else[/COLOR]
            [COLOR="Navy"]Set[/COLOR] nRng = Union(nRng, .item(K)(0))
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] K
nRng.EntireRow.Delete
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[knigget]

Thanks Mick, about to knock off for the day but am inclined to try this at home as its annoyed me all week!

I will let you, thanks for the quick reply

 

[knigget]

Hi Mick,

This seems to work a treat except for one thing - there is a blank line inserted (or leftover) between the remaining two rows.

I have a few questions also:

[COLOR=#000080]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))

Is A1 to tell the macro to start at the top of the column? My headers take up A1, A2 so should I set it to "A3" ?

If you wouldn't mind explaining some of the code, that will be very helpful for me for future reference, and also to the viewers of this board.

Thanks for your help so far Mick, really very much appreciated.

 

[MickG]

Try this:-
The code starts now at "A3" and also removes Blank rows.
Below this code is another code that does the same (Hopefully) but is a bit more concise.
NB:- Scrip dictionarys form collections, in this case all the items in column "A" that are the same are collected as sets of that unique item, when
duplicate items are found they are added within that items set.

[COLOR="Navy"]Sub[/COLOR] MG15Aug32
[COLOR="Navy"]Dim[/COLOR] Rng     [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn       [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] nRng    [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Q       [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] K       [COLOR="Navy"]As[/COLOR] Variant
'[COLOR="Green"][B]==Sets Range with data in colum "A"[/B][/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A3"), Range("A" & Rows.Count).End(xlUp))
 
 '[COLOR="Green"][B]== Removes blank rows[/B][/COLOR]
 Rng.EntireRow.SpecialCells(xlCellTypeBlanks).Delete
   
   '[COLOR="Green"][B]== Sets up Scrip dictionary[/B][/COLOR]
    [COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
        .CompareMode = vbTextCompare
'[COLOR="Green"][B]==Start loop through "Rng"[/B][/COLOR]
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
   '[COLOR="Green"][B]==Finds Unique Data[/B][/COLOR]
   [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
        '[COLOR="Green"][B]Adds Key (first unique found), Set up "Item" Array first item "Nothing"  second item the First value.[/B][/COLOR]
        '[COLOR="Green"][B]==(Key),   "Item"[/B][/COLOR]
        .Add Dn.Value, Array(Nothing, Dn)
    [COLOR="Navy"]Else[/COLOR]
        '[COLOR="Green"][B]== Q equals the array above[/B][/COLOR]
        Q = .item(Dn.Value)
            '[COLOR="Green"][B]==Q(0) is first item in array[/B][/COLOR]
            [COLOR="Navy"]If[/COLOR] Q(0) [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
                '[COLOR="Green"][B]==set first item to second Item[/B][/COLOR]
                [COLOR="Navy"]Set[/COLOR] Q(0) = Q(1)
                '[COLOR="Green"][B]second item = dn[/B][/COLOR]
                [COLOR="Navy"]Set[/COLOR] Q(1) = Dn
            [COLOR="Navy"]Else[/COLOR]
                '[COLOR="Green"][B]as above but adding more items (addresses) to first item "Q(0)"[/B][/COLOR]
                [COLOR="Navy"]Set[/COLOR] Q(0) = Union(Q(0), Q(1))
                [COLOR="Navy"]Set[/COLOR] Q(1) = Dn
            [COLOR="Navy"]End[/COLOR] If
        '[COLOR="Green"][B]=place altered data back in array[/B][/COLOR]
        '[COLOR="Green"][B]=[/B][/COLOR]
        .item(Dn.Value) = Q
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
'[COLOR="Green"][B]= loop through all items in scrip dic[/B][/COLOR]
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
    '[COLOR="Green"][B]==Loop through keys in dictionary to produce the range to delete[/B][/COLOR]
    '[COLOR="Green"][B]==NB:- as we are looking only in First item in array "q(0)", the last _[/B][/COLOR]
    '[COLOR="Green"][B]item in your range (The one you don't want to remove will be in Q(2) (second item) and will be left.[/B][/COLOR]
    [COLOR="Navy"]If[/COLOR] Not .item(K)(0) [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]If[/COLOR] nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]Set[/COLOR] nRng = .item(K)(0)
        [COLOR="Navy"]Else[/COLOR]
            [COLOR="Navy"]Set[/COLOR] nRng = Union(nRng, .item(K)(0))
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] K
nRng.EntireRow.Delete
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

This code is basically the same , but with the last loop being incorporated within the Scrip-Dic loop.

[COLOR="Navy"]Sub[/COLOR] MG15Aug53
[COLOR="Navy"]Dim[/COLOR] Rng     [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn      [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] nRng    [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Q       [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] K       [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A3"), Range("A" & Rows.Count).End(xlUp))
  Rng.EntireRow.SpecialCells(xlCellTypeBlanks).Delete
    [COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
        .CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Dn <> "" [COLOR="Navy"]Then[/COLOR]
    [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
        .Add Dn.Value, Array(Nothing, Dn)
    [COLOR="Navy"]Else[/COLOR]
        Q = .item(Dn.Value)
            [COLOR="Navy"]If[/COLOR] nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
                [COLOR="Navy"]Set[/COLOR] Q(0) = Q(1)
                [COLOR="Navy"]Set[/COLOR] Q(1) = Dn
                [COLOR="Navy"]Set[/COLOR] nRng = Q(0)
            [COLOR="Navy"]Else[/COLOR]
                [COLOR="Navy"]Set[/COLOR] Q(0) = Q(1)
                [COLOR="Navy"]Set[/COLOR] nRng = Union(nRng, Q(0))
                [COLOR="Navy"]Set[/COLOR] Q(1) = Dn
            [COLOR="Navy"]End[/COLOR] If
        .item(Dn.Value) = Q
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
nRng.EntireRow.Delete
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[knigget]

Thanks Mick,

The first one gives me a compile error 'Expected End With'.

The second works perfect and I haven't managed to trip it up yet

 

[MickG]

Sorry about that , its my copying.
Place an "End With" (no commas) just above the "End Sub"
Regards Mick

 

[knigget]

It doesn't appear to be working on column A exclusively. If you put data into any other column (below line 3) it does odd things. You are right in that it does remove duplicates but only on the first macro run. If you run the macro again (and again and again!) thats when oddness starts to happen.

Any ideas?