"psilzle" <(E-Mail Removed)> wrote in message
news:(E-Mail Removed)...
>I could give it a try. It is better then the nothing I have. :-)
>
> Thanks!
>
> Paul
Here it is:
Sub SelezionaDoppioni()
Static NumLast As Long
Dim i As Long, j As Long, k As Long, ColorCode As Long
Dim Ra1 As Range, NumCell As Long
Dim DoubletonFound As Boolean, SkipBlank As Boolean
' Definizioni
' ---------------------------
ColorCode = 35 ' 13434828
Set Ra1 = [Sheet2!A53

59]
' ---------------------------
NumCell = Ra1.Count
Ra1.Interior.ColorIndex = xlNone
SkipBlank = True
Select Case NumLast
Case Is = 0
NumLast = 1
Case Is = NumCell
NumLast = 1
Exit Sub
End Select
For i = NumLast To NumCell - 1
If IsEmpty(Ra1.Item(i)) And SkipBlank Then GoTo Continue
For j = i + 1 To NumCell
For k = 1 To NumLast - 1
If Ra1.Item(i) = Ra1.Item(k) Then
GoTo Continue
End If
Next
If Ra1.Item(i) = Ra1.Item(j) Then
Ra1.Item(i).Interior.ColorIndex = ColorCode
Ra1.Item(j).Interior.ColorIndex = ColorCode
'Ra1.Item(j).Select
DoubletonFound = True
End If
Next
If DoubletonFound Then
NumLast = i + 1
Exit Sub
End If
Continue:
Next
If Not DoubletonFound And i = NumCell Then
NumLast = 1
End If
End Sub
Bruno