Do Until loop query

[shumba]

Hi,


Column A has a list of three letter codes placed in each cell and is periodically updated.


The Sub Procedure below (kindly supplied by Michael) is designed to check the most recently added code against the codes already on the list. If the code is the same as any added before then it is deleted from the list.

Sub delem()
      Dim lr As Long, r As Long
      lr = Cells(Rows.Count, "A").End(xlUp).Row
      For r = lr - 1 To 9 Step -1
          If Range("A" & lr).Value = Range("A" & r).Value Then Rows(lr).Delete
      Next r
  End Sub

Please will someone show me the best way to loop this procedure up the list. At the moment it works well on the most recently added code. As there might be a number of duplicated codes added to the list at any one time I would like to be able to remove them as well. Being a novice at VBA I presume some sort off Do Until Loop would be the way to go.


Thanks,


Rob.

 

[VoG]

Try

Sub delem()
Dim LR As Long, r As Long
LR = Cells(Rows.Count, "A").End(xlUp).Row
For r = LR To 9 Step -1
    If WorksheetFunction.CountIf(Columns("A"), Range("A" & r).Value) > 1 Then Rows(r).Delete
Next r
End Sub

 

[shumba]

Thanks Peter, it works great.

Regards,

Rob