Check for duplicate values

[Freddy]

What VB macro code can be used to check for duplicate values AFTER all
entries are made into a column instead of as they are being entered? I am
running Microsoft Visual Basic 6.5 in Office 2002. I found the code below,
written by Ardus Petus, that checks for duplicate values AS THEY ARE ENTERED:

'----------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
'Adjust next constant to your own needs
Const myColumn As String = "B"
Dim rng As Range
Dim Found As Range

Set rng = Columns(myColumn)
If Intersect(Target, rng) Is Nothing Then Exit Sub
Set Found = rng.Find(Target.Value)
If Found.Address <> Target.Address Then MsgBox ("Duplicate code")
End Sub
'-----------------------------------

 

[Jacob Skaria]

Modified...Try the below and feedback

Sub Macro()
'Adjust next constant to your own needs
Const myColumn As String = "B"
Dim rng As Range
Dim cell As Range
Dim Found As Range

lngLastRow = ActiveSheet.Cells(Rows.Count, myColumn).End(xlUp).Row
Set rng = Range(mycolumn & "1:" & mycolumn & lngLastRow)
For Each cell In rng
If cell.Text <> "" And IsError(cell.Value) <> True Then
Set Found = rng.Find(cell.Value)
If Not Found Is Nothing Then
If Found.Address <> cell.Address Then cell.Interior.Color = vbRed
End If
End If
Next

End Sub

 

[Freddy]

It worked very well. Can it be modified to inform the user whether or not
duplicates were found and, if necessary, make corrections then rerun the
macro to check for duplicates again?

 

[Jacob Skaria]

Untested...Try and feedback

Sub Macro()
'Adjust next constant to your own needs
Const myColumn As String = "B"
Dim rng As Range
Dim cell As Range
Dim Found As Range
Dim blnCount as Boolean

lngLastRow = ActiveSheet.Cells(Rows.Count, myColumn).End(xlUp).Row
Set rng = Range(mycolumn & "1:" & mycolumn & lngLastRow)
rng.Interior.ColorIndex = xlNone
For Each cell In rng
If cell.Text <> "" And IsError(cell.Value) <> True Then
Set Found = rng.Find(cell.Value)
If Not Found Is Nothing Then
If Found.Address <> cell.Address Then
cell.Interior.Color = vbRed:blnFound = True
End If
End If
End If
Next

If blnFound = True then Msgbox "Duplicates Found"

End Sub

 

[Jacob Skaria]

Typo...corrected..

Sub Macro()
'Adjust next constant to your own needs
Const myColumn As String = "B"
Dim rng As Range
Dim cell As Range
Dim Found As Range
Dim blnFound as Boolean

lngLastRow = ActiveSheet.Cells(Rows.Count, myColumn).End(xlUp).Row
Set rng = Range(mycolumn & "1:" & mycolumn & lngLastRow)
rng.Interior.ColorIndex = xlNone
For Each cell In rng
If cell.Text <> "" And IsError(cell.Value) <> True Then
Set Found = rng.Find(cell.Value)
If Not Found Is Nothing Then
If Found.Address <> cell.Address Then
cell.Interior.Color = vbRed:blnFound = True
End If
End If
End If
Next

If blnFound = True then Msgbox "Duplicates Found"

End Sub

 

[Freddy]

Tested successfully. I removed "rng.Interior.ColorIndex = xlNone". Would it
be possible to increase the range from one column to multiple columns?