delete all duplicates except one

daveyc18

Well-known Member
Joined
Feb 11, 2013
Messages
706
Office Version
  1. 365
  2. 2010
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:

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
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
 
Upvote 0
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!
 
Upvote 0
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
 
Upvote 0
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.
 
Upvote 0
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

  • 2DA0E3AF-ED5D-457A-BD60-13C81C0E9329.jpeg
    2DA0E3AF-ED5D-457A-BD60-13C81C0E9329.jpeg
    168.4 KB · Views: 15
Upvote 0
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.
 
Upvote 0
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

  • 20200124_034817.jpg
    20200124_034817.jpg
    197.4 KB · Views: 13
  • 20200124_034749.jpg
    20200124_034749.jpg
    211.3 KB · Views: 14
Upvote 0
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.
 
Upvote 0
The Scripting.Dictionary is part of ActiveX, so cannot be used on a Mac.
 
Upvote 0

Forum statistics

Threads
1,213,510
Messages
6,114,034
Members
448,543
Latest member
MartinLarkin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top