basic unique refs loop

[JZB]

Hi

I am creating a loop that deletes any duplicates. so the logic is to put the data into ascending order then delete an entry if it equals the preceeding:

nlastrow = Range("A65536").End(xlUp).Row

Range("A2").Select

For nloop = 1 To nlastrow

If InStr(ActiveCell, ActiveCell.Offset(-1, 0)) = 1 Then
ActiveCell.EntireRow.Delete

Else: ActiveCell.Offset(1, 0).Select

End If

Next nloop


the problem: the loop i have created is deleting not only identical refs but those with similarities. e.g. row1 has DPC1, row 2 has DPC2. however the current loop is deleting DPC2. :banghead:

the instr statement needs to be modified, i thought = 1 meant they had to be identical but i must be wrong.

can someone advise?

[Paul_Hossler]

I think it's better to go from the bottom up when deleting rows

Also not sure why you wanted InStr

Not tested but maybe something like this


nlastrow = Range("A65536").End(xlUp).Row


For nloop = nlastrow to 2 Step -1

If Cells(nloop,1).Value = Cells(nloop-1,1).Value Then
Rows(nloop).Delete
End If

Next nloop

[mdmackillop]

When dealing with duplicates, I always reach for this (http://xldynamic.com/source/xld.DupMaster.html).

[JONvdHeyden]

Personally I prefer to use a filter method when deleting rows based on criteria. Either AutoFilter or Advanced Filter. Filter methods tend to be substantially quicker when dealing with larger ranges.


Sub Del_Dupes()

Dim lRow As Long, rngCrit As Range
Set rngCrit = Cells(2, Columns.Count).End(xlToLeft).Offset(, 2)
lRow = Cells(Rows.Count, 1).End(xlUp).Row

rngCrit.FormulaR1C1 = "=RC1=R[-1]C1"

With Cells(1, 1).Resize(lRow)
.AdvancedFilter action:=xlFilterInPlace, criteriarange:=rngCrit.Offset(-1).Resize(2)
.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With

ActiveSheet.ShowAllData

End Sub

[JZB]

appreciate the help guys. all v useful.

:friends: