Finding duplicates VBA macro not working with numbers

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

This formula is working for alphabetic words. I need it to work with number (phone numbers)

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

Workbook8.xlsx