Delete entire row if two cells are duplicate

[Les Stout]

Hi all, i have some code that i got from a search and it was apparantly
supplied by Tom Ogilvy. I need to understand it, as i have a lot of
lines and i need to loop down deleteing lines with duplicate numbers in
Column "A" & "D". However if Column "A" number is different and "D" is
the same it must not delete !! Any help would be greatly appreciated..

Sub DeleteDuplicateRows()
Dim RowNdx As Long
Dim ColNum As Integer
Dim rng As Range
ColNum = Selection(1).Column
For RowNdx = Selection(Selection.Cells.Count).Row To _
Selection(1).Row + 1 Step -1
If Cells(RowNdx, ColNum).Value = Cells(RowNdx - 1, ColNum).Value
Then
If rng Is Nothing Then
Set rng = Cells(RowNdx, ColNum)
Else
Set rng = Union(rng, Cells(RowNdx, ColNum))
End If
End If
Next RowNdx
If Not rng Is Nothing Then
rng.EntireRow.Delete
End If
End Sub

Les Stout

 

[Bob Phillips]

It's very simple Les, Tom is just working back through a selected range, and
if a cell in the first column of the selected range is equal to the previous
row,. it adds it to a range that it is building up through the process. At
the end, if the accrued range is not empty, it deletes the whole row(s)
associated with that range.

As I say it is relatively simple, but there are two nice bits there

Selection(1).Row + 1

works out the row number of the first row in the selected range and adds 1
to it (as it checks a row to the previous, no need to process row 1)

Selection(Selection.Cells.Count).Row

This works out the row number of the selected range.

I am surprised to see Tom working backwards through the range. That is
normally done if you delete as you go, but as he is accruing the 'to be
deleted' cells as he goes within a range object, there is no need, it works
just as well going forwards.

--
HTH

Bob Phillips

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

 

[Les Stout]

Hi Bob, thanks for the reply sorry i am still not too hot at this game,
i have a spread sheet as per below... I need to look at columns A & D,
going either up or down and delete (Indicated by "Del") duplicate
numbers in column "D"
However if there is a number in column "A" that is different, (Marked
with "S")below, but "D" is the same then it must not delete the instance
of the new number in column "A". I hope i have explained this well
enough, if not i can e-mail you the spreadsheet. Thanks again for the
help...

A B C D E
gAMS Description Status UPG Part No.

AAB05U HA-Getriebe Approved K3311 7518411
AAB05U HA-Getriebe Approved K3311 7518403 Del
AAB05U HA-Getriebe Approved K3311 7541580 Del
AAB05U HA-Getriebe Approved K0751 1214215
AAB05U HA-Getriebe Approved K0751 1214215 Del
AAB05U HA-Getriebe Approved K0751 1214215 Del
AAB05U HA-Getriebe Approved K0751 1214215 Del
AAF15U BlowBy- Approved K1371 7556551
AAF15U BlowBy- Approved K1371 7556551 Del
AAJ28U Getriebeoel Approved K1722 7800495
AAJ28U Getriebeoel Approved K1722 7800495 Del
AAJ28U Getriebeoel Approved K1722 7523433 Del
AAJ28U Getriebeoel Approved K1722 7523433 Del
AAK20U Vorderachs Approved K3153 7502681
AAK20U Vorderachs Approved K3153 7560917 Del
AAK45U Getriebekabel Approved K1251 7548984
AAK45U Getriebekabel Approved K1251 7548984 Del
AAK45U Getriebekabel Approved K1251 7548982 Del
AAK45U Getriebekabel Approved K1251 7548982 Del "S"
AAK78U Schalthebeltilg Checking K1251 7560902 "S"
AAK78U Schalthebeltilg Checking K1251 7529070 Del
AAK78U Schalthebeltilg Checking K1251 7560909 Del



Les Stout

 

[Bob Phillips]

Les,

This should do it for you

Sub DeleteDuplicateRows()
Dim iRow As Long
Dim iCol As Integer
Dim rng As Range

iCol = 1 '<==== assuming start at column A

For iRow = 2 To Cells(Rows.Count, iCol).End(xlUp).Row
If Cells(iRow, iCol).Value = Cells(iRow - 1, iCol).Value And _
Cells(iRow, iCol + 3).Value = Cells(iRow - 1, iCol + 3).Value
Then
If rng Is Nothing Then
Set rng = Rows(iRow)
Else
Set rng = Union(rng, Rows(iRow))
End If
End If
Next iRow

If Not rng Is Nothing Then
rng.Delete
End If
End Sub

--
HTH

Bob Phillips

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

 

[Les Stout]

You guys never sieze to amaze me, thanks a million Bob, works like a
dream.
Hope you have a great weekend...

Les Stout