finde dublet og indsætte et tal istedet

Public Sub Dubletter()
    Dim Data As Variant, Data2() As Variant
    col = 3
    RowCount = Cells(65536, col).End(xlUp).Row
    Data = Range(Cells(1, col), Cells(65536, col).End(xlUp))
    ReDim Data2(UBound(Data) + 1)
    For i = 1 To UBound(Data)
        If IsEmpty(Data2(i)) Then
            For I1 = i + 1 To UBound(Data)
                If Data(i, 1) = Data(I1, 1) Then
                    Data2(I1) = 1
                End If
            Next
        End If
    Next
    For i = 1 To UBound(Data2)
        If Data2(i) = 1 Then
            Cells(i, col) = Application.WorksheetFunction.Max(Data) + 1
            Data = Range(Cells(1, col), Cells(65536, col).End(xlUp))
        End If
    Next
End Sub

Ups, der gik lidt tid inden jeg fik testet.
Den gør som jeg bad om i første huk.
Godt gået

Så mangler vi bare pointene..

et svar ;-))