Thank you very much, that's what I needed and I couldn't do it myself.

Tomek




Jim Thomlinson wrote:

This code assumes that your data in column C is continuious with no empty
rows (it stops at the first empty row). It processes the active sheet but
that can be changed easily, and assumes that the data starts in the second
row...

Public Sub FindDuplicates()
Dim shtCurrent As Worksheet
Dim rngToSearch As Range
Dim rngFound As Range
Dim strFirstAddress As String
Dim rngToFind As Range

Set shtCurrent = ActiveSheet
Set rngToFind = shtCurrent.Range("C2")
Set rngToSearch = shtCurrent.Range("A1").EntireColumn
Do While rngToFind < Empty
Set rngFound = rngToSearch.Find(rngToFind.Value, , , xlPart)
If Not rngFound Is Nothing Then
strFirstAddress = rngFound.Address
Do
rngFound.Offset(0, 1).Value = rngToFind
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFound.Address = strFirstAddress
End If
Set rngToFind = rngToFind.Offset(1, 0)
Loop

End Sub

HTH
"Tomek" wrote:

--
Tomek