Solved: Duplicates

[drums4monty]

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]

Try this
[VBA]
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
[/VBA]
This will high light duplicates in Column A, someone from this forum created it.

[drums4monty]

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]

[vba]

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
[/vba]

[drums4monty]

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]

[vba]

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

[/vba]

[drums4monty]

Thats it xld, perfect. Many thanks

[drums4monty]

As my sheet is large, is there a way to add a msgbox that tell me how many duplicates were found?

Alan

[Bob Phillips]

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]

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]

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]

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]

I guess this will do it

[vba]

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
[/vba]

[drums4monty]

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]

[vba]

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
[/vba]

[brettdj]

try my addin at http://members.iinet.net.au/~brettdj/

[TrippyTom]

Hey Brett,

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

[drums4monty]

Hi Brett

Many thanks for that.

Alan