Does this do it Les?

Sub Test()
Dim iLastRow As Long
Dim i As Long

iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = iLastRow To 2 Step -1
If Cells(i, "A").Value = Cells(i - 1, "A").Value And _
Application.CountIf(Columns(4), Cells(i, "D").Value) 1 Then
Rows(i).Delete
End If
Next i

End Sub


--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

"Les Stout" wrote in message
...
Hi All, Bob helped me with some code last week to delete rows if a field
was duplicate, which works a treat. I have now the following problem...
If the numbers in column "A"
are the same & there are two instances of the number in column "D", then
one must be deleted...


"A" "B" "C" "D"
A13735 Neues Creation K6512
A1697U Quako: Approved K3450 ok
A1697U Quako: Approved K6631 ok
A1697U Quako: Approved K6111 ok
A1753U Lenkge Approved K3210
A2366U QUAKO: Approved K3320 ok
A2366U QUAKO: Approved K3321 ok
A2366U QUAKO: Approved K3320 Delete
A2366U QUAKO: Approved K3321 Delete
A2366U QUAKO: Approved K3320 Delete
A2366U QUAKO: Approved K3321 Delete
A2366U QUAKO: Approved K3320 Delete
A2366U QUAKO: Approved K3160 ok
A2568U CBS K1214
A4175U Sitz Approved K4151
A4175U Sitz Approved K4152
A4569U Funkti Checked K6210 ok
A4569U Funktio Checked K6512 ok
A4569U Funktio Checked K6583 ok
A5784U Motorle Approved K1252
A5784U Motorle Approved K1251
A5784U Motorle Approved K1252 Delete

I hope this example surfices, thanks..

Les Stout

*** Sent via Developersdex http://www.developersdex.com ***