VBA macro not running. Finding duplicates macro

Here is a formula that I cannot get working anymore. I used it 2 years ago and I don't remember how it works.

This formula has to detects duplicates from column A and has to mark same duplicates with specific number in the next column

Formula:

Sub duplicates()

 Dim OCell As Range, ProductInfo As Range

 Dim FirstAddress As String

 Dim i As Integer, u As Integer, ProdCount As Integer

Application.ScreenUpdating = False

 

u = 1

Range("A:A").Activate

  With ActiveSheet

     

     Do Until ActiveCell = ""

        

       If ActiveCell.Offset(0, 1) <> "" Then

         Do

         ActiveCell.Offset(1, 0).Activate

         Loop Until ActiveCell.Offset(0, 1) = ""

   

           FirstAddress = ActiveCell.Address

           Range(FirstAddress).Activate

       End If

        

        Set ProductInfo = ActiveCell

        FirstAddress = ActiveCell.Address

          

             With .Columns("A:A")

                  ProdCount = WorksheetFunction.CountIf(.Columns("A:A"), ProductInfo)

        

                   If ProdCount > 1 Then

                    Set OCell = .Find(ProductInfo.Value, LookAt:=xlWhole)

                          OCell.Activate

                           ActiveCell.Offset(0, 1) = u

                             For i = 1 To ProdCount - 1

                                 Set OCell = .FindNext(OCell)

                                 OCell.Activate

                            ActiveCell.Offset(0, 1) = u

                             Next i

 u = u + 1

                   Else

                   Range(FirstAddress).Offset(1, 0).Activate

                   End If

             End With

10

       

                   Set OCell = Nothing

                   ProdCount = 0

                   Range(FirstAddress).Offset(1, 0).Activate

     Loop

  End With

Range("A:A").Select

Application.CutCopyMode = False

Application.ScreenUpdating = True

Set ProductInfo = Nothing

Set OCell = Nothing

End Sub