delete all duplicates except one

daveyc18

Active Member
Joined
Feb 11, 2013
Messages
401
im trying to delete all duplicates based on an ID in column F, except one (it doesn't matter which one I keep...ie it could be the first one, could be the last duplicate).

trying to do this with a macro.
 
Last edited:

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
9,577
Office Version
2007
Platform
Windows
Try this
I guess the data starts in row 2

Code:
Sub Delete_Rows()
  Dim lr As Long, i As Long, a, r As Range, dict As Object
  Application.ScreenUpdating = False
  lr = Range("A" & Rows.Count).End(xlUp).Row
  Set r = Range("A" & lr + 1)
  Set dict = CreateObject("scripting.dictionary")
  a = Range("F2:F" & lr)
  For i = 1 To UBound(a)
    If Not dict.exists(a(i, 1)) Then
      dict(a(i, 1)) = dict(a(i, 1))
    Else
      Set r = Union(r, Range("A" & i + 1))
    End If
  Next i
  r.EntireRow.Delete
End Sub
 

daveyc18

Active Member
Joined
Feb 11, 2013
Messages
401
Try this
I guess the data starts in row 2

Code:
Sub Delete_Rows()
  Dim lr As Long, i As Long, a, r As Range, dict As Object
  Application.ScreenUpdating = False
  lr = Range("A" & Rows.Count).End(xlUp).Row
  Set r = Range("A" & lr + 1)
  Set dict = CreateObject("scripting.dictionary")
  a = Range("F2:F" & lr)
  For i = 1 To UBound(a)
    If Not dict.exists(a(i, 1)) Then
      dict(a(i, 1)) = dict(a(i, 1))
    Else
      Set r = Union(r, Range("A" & i + 1))
    End If
  Next i
  r.EntireRow.Delete
End Sub

youre always so helpful...and the code worked! vba genius!
 

daveyc18

Active Member
Joined
Feb 11, 2013
Messages
401
Try this
I guess the data starts in row 2

Code:
Sub Delete_Rows()
  Dim lr As Long, i As Long, a, r As Range, dict As Object
  Application.ScreenUpdating = False
  lr = Range("A" & Rows.Count).End(xlUp).Row
  Set r = Range("A" & lr + 1)
  Set dict = CreateObject("scripting.dictionary")
  a = Range("F2:F" & lr)
  For i = 1 To UBound(a)
    If Not dict.exists(a(i, 1)) Then
      dict(a(i, 1)) = dict(a(i, 1))
    Else
      Set r = Union(r, Range("A" & i + 1))
    End If
  Next i
  r.EntireRow.Delete
End Sub
what is this scripting.dictionary? i semi understand your code
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
9,577
Office Version
2007
Platform
Windows
what is this scripting.dictionary? i semi understand your code
A Dictionary is used, among other things, to store items.

In this example it stores the unique values, if the value already exists in the dictionary then in the object r the "cell" is stored to be deleted.
 

gfdwer2

New Member
Joined
Jan 22, 2020
Messages
21
Office Version
2010
Platform
Windows
Try this
I guess the data starts in row 2

Code:
Sub Delete_Rows()
  Dim lr As Long, i As Long, a, r As Range, dict As Object
  Application.ScreenUpdating = False
  lr = Range("A" & Rows.Count).End(xlUp).Row
  Set r = Range("A" & lr + 1)
  Set dict = CreateObject("scripting.dictionary")
  a = Range("F2:F" & lr)
  For i = 1 To UBound(a)
    If Not dict.exists(a(i, 1)) Then
      dict(a(i, 1)) = dict(a(i, 1))
    Else
      Set r = Union(r, Range("A" & i + 1))
    End If
  Next i
  r.EntireRow.Delete
End Sub
Hi! Is there anyway not to use ActiveX? Because from my end, I can not use ActiveX and on your code >> Set dict = CreateObject("scripting.dictionary") is an activeX component.
I have the same problem as above, in my case I have to remove only the CONTENTS of the cells which are duplicate and retain only one which is the top most. The range in which the code is to be applied is B12:B24 (see attached image). I tried different code but it removed including the borders, shade, formatting etc. of the cell with duplicate which where removed. Basically if there is a way to associate .ClearContents and .RemoveDuplicates if its even possible or if there is a similar way.
 

Attachments

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
9,577
Office Version
2007
Platform
Windows
Set dict = CreateObject("scripting.dictionary") is an activeX component.
It seems to me that it is not an activex control.
Do you have any error message?

Do you want to delete the row or just clear the contents of the cells?

You can put 2 images.
One with "duplicate" data and another image with the result you need.
 

gfdwer2

New Member
Joined
Jan 22, 2020
Messages
21
Office Version
2010
Platform
Windows
It seems to me that it is not an activex control.
Do you have any error message?

Do you want to delete the row or just clear the contents of the cells?

You can put 2 images.
One with "duplicate" data and another image with the result you need.
Thank you for your prompt response. I only need to clear the contents of the cell. It should NOT delete the row.

Please see attached images. Thank you
 

Attachments

gfdwer2

New Member
Joined
Jan 22, 2020
Messages
21
Office Version
2010
Platform
Windows
By the way, don't mind about what I said earlier about activex control. Because if I use Mac the error message says that I'm using an activex control even if it's not. This time I will use windows to run your code.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
33,461
Office Version
365
Platform
Windows
The Scripting.Dictionary is part of ActiveX, so cannot be used on a Mac.
 

Forum statistics

Threads
1,084,937
Messages
5,380,685
Members
401,694
Latest member
Bette980

Some videos you may like

This Week's Hot Topics

Top