PDA

View Full Version : Solved: Duplicates



drums4monty
08-01-2007, 09:04 AM
I have a large spreadsheet with Surname in Col A, First Name in Col B, and various other data in the other Cols. Is there a way to check if there are any duplicate names and highlight them?

Alan

JKwan
08-01-2007, 09:55 AM
Try this

Sub HiLiteDuplicates()
' This will create a Conditional Format of highliting duplicates
Range("A1:A100").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=countif($A$1:$A$100,a1)>1"
Selection.FormatConditions(1).Font.ColorIndex = 3
End Sub

This will high light duplicates in Column A, someone from this forum created it.

drums4monty
08-01-2007, 11:07 AM
Thanks JKwan this works great. Would it be possible to make it include Col B which is the Forename as well, so Smith, David & Smith, David would be highlighted but Smith, David & Smith, John would not?

Alan

Bob Phillips
08-01-2007, 11:33 AM
Sub HiLiteDuplicates()
' This will create a Conditional Format of highliting duplicates
Range("A1:B100").Select
With Selection
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:="=countif($A$1:$A$100,$A1)>1"
.FormatConditions(1).Interior.ColorIndex = 3
End With
End Sub

drums4monty
08-01-2007, 03:37 PM
Thanks xld but I think you misunderstood me, I have tried your code and it highlights col A & B but also all the instances of a surname that is the same whether the first name is the same or not. If the surname are duplicated in the list then highlight them but if they are different then dont (Smith, David & Smith, David would be highlighted but Smith, David & Smith, John would not)

Bob Phillips
08-01-2007, 03:46 PM
Sub HiLiteDuplicates()
' This will create a Conditional Format of highliting duplicates
Range("A1:B100").Select
With Selection
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:="=SUMPRODUCT(($A$1:$A$100=$A1)*($B$1:$B$100=$B1))>1"
.FormatConditions(1).Interior.ColorIndex = 3
End With
End Sub

drums4monty
08-01-2007, 04:03 PM
Thats it xld, perfect. Many thanks

drums4monty
08-02-2007, 12:04 AM
As my sheet is large, is there a way to add a msgbox that tell me how many duplicates were found?

Alan

Bob Phillips
08-02-2007, 01:08 AM
It would get very messy as you either loop through checking each one, or you add a helper column, or you add complex code to count which are CF formatted.

Whcih would you prefer?

drums4monty
08-02-2007, 01:18 AM
Hi xld

If it too messy/complex then I wont bother, many thanks for your help. One last thing. Would it be too messy to add a box to ask how big the range is as sometimes it could be 100 rows, sometimes maybe 150 rows etc?

Bob Phillips
08-02-2007, 01:20 AM
How do you determine the range? The code I gave set it at A1:B100, but I assume you have a more dynamic method.

drums4monty
08-02-2007, 01:27 AM
Dont know what you mean? You set the range at A1:B100, could you add a dialog box to ask what range I want e.g. A1:B150 or A1:B250 etc. A1 will always be the same.

Bob Phillips
08-02-2007, 01:39 AM
I guess this will do it



Sub HiLiteDuplicates()
' This will create a Conditional Format of highliting duplicates
Dim rng As Range
Dim CFFormula As String
Dim mpLastRow As Long

'set you range however is appropriate
mpLastRow = Cells(Rows.Count, "A").End(xlUp).Row
Set rng = Range("A1:B1").Resize(mpLastRow)
CFFormula = "=SUMPRODUCT(($A$1:$A$" & rng.Rows.Count & "=$A1)*($B$1:$B$" & rng.Rows.Count & "=$B1))>1"
rng.Select
With Selection
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:=CFFormula
.FormatConditions(1).Interior.ColorIndex = 3
End With
MsgBox "Range is = " & rng.Rows.Count & " rows"
End Sub

drums4monty
08-02-2007, 01:58 AM
Nearly there, I meant when you run the macro you get a box asking you to enter the range you want which then becomes the current range. Is this possible?

Bob Phillips
08-02-2007, 04:15 AM
Sub HiLiteDuplicates()
' This will create a Conditional Format of highliting duplicates
Dim rng As Range
Dim CFFormula As String
Dim mpLastRow As Long

Set rng = Nothing
Set rng = Application.InputBox(prompt:="Select a cell", Type:=8)

If rng Is Nothing Then Exit Sub
CFFormula = "=SUMPRODUCT((" & rng.Columns(1).Address & "=" & rng.Cells(1, 1).Address(False, True) & ")*" & _
"(" & rng.Columns(2).Address & "=" & rng.Cells(1, 2).Address(False, True) & "))>1"
rng.Select
With Selection
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:=CFFormula
.FormatConditions(1).Interior.ColorIndex = 3
End With
MsgBox "Range is = " & rng.Rows.Count & " rows"
End Sub

brettdj
08-02-2007, 05:13 AM
try my addin at http://members.iinet.net.au/~brettdj/

TrippyTom
08-02-2007, 10:57 AM
Hey Brett,

Thanks for posting that link. I'm sure that will come in handy.

drums4monty
08-05-2007, 12:03 AM
Hi Brett

Many thanks for that.

Alan