delete all duplicates except one

[daveyc18]

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.

 

[DanteAmor]

Try this
I guess the data starts in row 2

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]

Try this
I guess the data starts in row 2

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]

Try this
I guess the data starts in row 2

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]

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]

Try this
I guess the data starts in row 2

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.

 

[DanteAmor]

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]

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

 

[gfdwer2]

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]

The Scripting.Dictionary is part of ActiveX, so cannot be used on a Mac.