Further help required please :)

[Les Stout]

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

 

[Bob Phillips]

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]

Hi Bob, it appears to be working great.... Could you please explain it
to me so that i can understand what it is doing ??

Thanks Bob, you really are a life saver...

Les Stout

 

[Bob Phillips]

Okay Les, this is what it does

first it calculates where the last row is
it then loops backwards from the last row to row 2 (backwards as it is
deleting rows, and row 2 as it is checking against the previous row)
if the value in column of the current row is the same as the value in column
A of the previous row AND the value in column B is repeated in column D
(Application.CountIf(Columns(4), Cells(i, "D").Value) > 1) then it deletes
the current row

--
HTH

Bob Phillips

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

 

[Les Stout]

Hi Bob, aftyer checking, i find that it is deleting some lines that it
should not be. If i could get an e-mail address i could send you the
spreadsheet, it might help explain better.


Les Stout

 

[Bob Phillips]

I think I might know what that is Les. I thought about such a situation, but
your example data didn't have such a situation.

Try this version

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 ActiveSheet.Evaluate("SUMPRODUCT(--(A1:A1000=A" & i & _
"),--(D11000=D" & i & "))") > 1 Then
Rows(i).Delete
End If
Next i

End Sub

If that doesn't work, click on my name in the posting header and you will
get my email address, which should be modified as in my signature.

--
HTH

Bob Phillips

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

 

[Les Stout]

Thanks a million Bob, you people cease to amaze me...
Bob, i have to do this on a weekly basis and my next step will be to
change the sheet name to a date (I can do) and then when i do the next
weeks report i will run the code and sort the data, add a new sheet and
then compare document numbers in A and then display all new numbers with
thier data in a new sheet "Differences".

I am not able to click on your name in the header ??

Les Stout

 

[Bob Phillips]

Les,

Of course, you post via developersdex, I was giving you details for Usenet.

I am sorry we cease to amaze you, we were hoping to perpetuate it <bg>

The email addy is bob dot ngs at google dot com - do the obvious with it. If
you want to post it there with a workbook and show me the steps that you
would go through (I can't quite envisage how your need works) I will get to
it as soon as I can. If you don't mind, I will re-post the answer here, in
case anyone else finds it useful.

--
HTH

Bob Phillips

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

 

[Les Stout]

Morning Bob, thanks for the reply... Have tried the e-mail addy with no
success...?? Was returned as not found also sent one to bob dot ngs at
gmail dot com which appeared to be go through ??

best regards,

Les Stout

 

[Bob Phillips]

Les, I got a test message (didn't realise you were down there <g>).

--
HTH

Bob Phillips

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

 

[Les Stout]

Hi Bob, got your reply thanks and have sent the spreadsheet with remarks
on it. Hope i have explained it well enough.

best regards,

Les Stout