DO in column B WHILE column A <>""

I have a copy, paste, and delete function that I do in column B based on a fixed range (B2:B1000) and most of the time it is way to many and every once in a while it is not enough. What I would like to do is have a variable range for those functions based on the numeric values in column A, like a do-while A:A <>. The numeric value in column A will always be between 1 and 999999. The values in column A are sorted smallest to largest. The function I do in A2 is =IF(A2=A3,"DUP","") than I copy it to the set range. Then I do copy and paste special, values. Then I delete all the rows that have DUP in column B. The values in column A are location numbers that I have to update and I format column A as "000000". I am hoping this will speed up the macro, the delete part of the code takes a while when there are only two rows that actually need to be deleted. (DUP = Duplicate)

   Range("B2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-1]=R[1]C[-1],""DUP"","""")"
    Range("B2").Select
    Selection.AutoFill Destination:=Range("B2:B1000")
    Range("B2:B1000").Select
    Columns("B:B").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

    Dim r As Long
    For r = Range("B" & Rows.Count).End(xlUp).Row To 1 Step -1
    If UCase(Left(Cells(r, "B").Text, 3)) = "DUP" Then Rows(r).Delete
    Next r

    Application.CutCopyMode = False
   
    'Range("A1").Select
    'Selection.End(xlUp).Offset(1, 0).Select   'End((xlUp)).Offset(1, 0).Select
    'ActiveSheet.Paste
    
    Dim r As Long
    For r = Range("B" & Rows.Count).End(xlUp).Row To 1 Step -1
    If UCase(Left(Cells(r, "B").Text, 3)) = "DUP" Then Rows(r).Delete
    Next r

    Application.CutCopyMode = False