PDA

View Full Version : Solved: Removing duplicates



BENatUSGS
06-17-2011, 12:02 PM
Hey All,
Have a quick question on how to remove duplicates through VB :dunno

If you look at the attached spread sheet(Hopefully I attached it correctly)..Sheet1 has multiple duplicates.


Excel has a nice remove duplicate feature that give the following code…
Columns("A:B").Select
ActiveSheet.Range("$A$1:$B$100000").RemoveDuplicates Columns:=Array(1, 2), Header _
:=xlYes

Sheet2 is the output of sheet1 after the code has finished.

As you can see National Canyon has been removed which is what I want. However, you can see that Paria was not removed because the Site # is different in column B. What I need the code to do is recognize that Paria is a duplicate in column A and then check if the site number is different in column B. If so, I would like to give the user an error stating the duplicates and highlight those rows. Any help would be much appreciated.

Thanks,
Ben

CatDaddy
06-17-2011, 12:56 PM
Columns("A:A").Select
ActiveSheet.Range("$A$1:$B$9").RemoveDuplicates Columns:=1, Header:=xlYes
Columns("B:B").Select
ActiveSheet.Range("$A$1:$B$9").RemoveDuplicates Columns:=2, Header:=xlYes

BENatUSGS
06-17-2011, 01:17 PM
Thanks a lot!
Is there a way to make it so that it doesn’t just delete it right away? The reason I ask is because the code you provided does remove the duplicate even if the site # is different but it may not be the correct one to remove.
So in the attached workbook, the sheet that needs to be checked for duplicates may have two sites named Paria but two different site numbers attached to those names. If this happens then it is a mistake and one of them was inputted into the sheet incorrectly. We can’t assume that we know which site and site number combination is correct. Therefore, I need something that simply lets the user know about this mistake and they have to manually change it to the correct form.
Let me know,
Ben

CatDaddy
06-17-2011, 01:26 PM
Sub Highlight_Duplicates()
Dim Cell As Variant
Dim Values As Range
Set Values = Range("A:B")
For Each Cell In Values
If WorksheetFunction.CountIf(Values, Cell.Value) > 1 Then
Cell.Interior.ColorIndex = 6
End If
Next Cell
End Sub

CatDaddy
06-17-2011, 01:30 PM
you work for the geological survey? thats pretty cool

BENatUSGS
06-17-2011, 01:46 PM
Thanks for all your help that works perfectly!
Ben