does this do what you want? i see it was exiting only after finding the 1st
match.

Sub FindDuplicates()
Dim colNum As String
Dim rng As Range, cell As Range
Dim rng1 As Range
colNum = "B"
With ActiveSheet
Set rng = .Range(.Cells(1, colNum), .Cells(Rows.Count, _
colNum).End(xlUp))
End With
For Each cell In rng
If Application.CountIf(rng, cell) 1 Then
If rng1 Is Nothing Then
Set rng1 = cell
Else
Set rng1 = Union(rng1, cell)
MsgBox "YOU HAVE ENTERED A DUPLICATE MANUFACTURER NAME"
_
& " (" & cell.Value & ")"
End If
End If
Next
End Sub
--


Gary


"Mekinnik" wrote in message
...
I copied and edited this code to find duplicate names in my worksheet column
B and then display a msgbox to tell the user so, however it is not working at
all. Please advise

Sub FindDuplicates()
Dim colNum As String
Dim rng As Range, cell As Range
Dim rng1 As Range
colNum = "B"
With ActiveSheet
Set rng = .Range(.Cells(1, colNum), .Cells(Rows.Count, colNum).End(xlUp))
End With
For Each cell In rng
If Application.CountIf(rng, cell) 1 Then
If rng1 Is Nothing Then
Set rng1 = cell
Else
Set rng1 = Union(rng1, cell)
End If
End If
Next
If Not rng1 Is Nothing Then
MsgBox "YOU HAVE ENTERED A DUPLICATE MANUFACTURER NAME"
End If
End Sub