Deleting Rows with data duplicated in 2 columns

[meganryan]

Hi there,

I am trying, with no luck, to create a VBA macro in Excel that will
delete rows with data duplicated in 2 columns. Column A has ID
numbers and Column B has Dates. I need to delete rows that have
duplicate ID No. AND Date and leave the other rows on the worksheet.

I have tried Chip Pearson's code which works well however it doesn't
allow for the dates in column B so it considered the latest date to be
the record to leave and deletes the rest.

Sub DeleteTheOldies()
Dim RowNdx As Long
For RowNdx = Range("A1").End(xlDown).Row To 2 Step -1
If Cells(RowNdx, "H").Value = Cells(RowNdx - 1, "H").Value Then
If Cells(RowNdx, "I").Value <= Cells(RowNdx - 1, "I").Value
Then
Rows(RowNdx).Delete
Else
Rows(RowNdx - 1).Delete
End If
End If
Next RowNdx
End Sub

Example - Before:

ID No. Date
123456 1-2-07
123456 1-2-07
123456 2-2-07
123456 2-2-07
123456 3-2-07
123456 3-2-07

Example - After:

ID No. Date
123456 1-2-07
123456 2-2-07
123456 3-2-07

Any advice will be greatly appreciate. Many thanks.

 

[Max]

In the interim while awaiting a vba solution from others ..

Here's a formulas way to get there ..
Assume source data in cols A and B, from row2 down
Using 3 empty cols to the right of the data

In E2:
=IF(SUMPRODUCT((A$2:A2=A2)*(B$2:B2=B2)*(A$2:A2<>"")*(B$2:B2<>""))>1,"",ROW())
Leave E1 blank

In F2:
=IF(ROW(A1)>COUNT($E:$E),"",INDEX(A:A,SMALL($E:$E,ROW(A1))))
Copy F2 to G2. Format G2 as date to taste. Select E2:G2, fill down to last
row of source data. Cols F & G will return the required results all neatly
bunched at the top. Freeze as values, then delete col E and source cols as
may be desired.

 

[chevetteau]

In the interim while awaiting a vba solution from others ..

Here's a formulas way to get there ..
Assume source data in cols A and B, from row2 down
Using 3 empty cols to the right of the data

In E2:
=IF(SUMPRODUCT((A$2:A2=A2)*(B$2:B2=B2)*(A$2:A2<>"")*(B$2:B2<>""))>1,"",ROW(­))
Leave E1 blank

In F2:
=IF(ROW(A1)>COUNT($E:$E),"",INDEX(A:A,SMALL($E:$E,ROW(A1))))
Copy F2 to G2. Format G2 as date to taste. Select E2:G2, fill down to last
row of source data. Cols F & G will return the required results all neatly
bunched at the top. Freeze as values, then delete col E and source cols as
may be desired.
--
Max
Singaporehttp://savefile.com/projects/236895
xdemechanik













- Show quoted text -

Thank you Max... this works a treat and is a great interim measure
until I can get the macro running.

 

[Max]

Good to hear that. You're welcome.

 

[Roger Govier]

Hi

Amending the code to the following works fine for me

Sub DeleteTheOldies()
Dim RowNdx As Long

For RowNdx = Range("A1").End(xlDown).Row To 2 Step -1
If Cells(RowNdx, "A").Value = Cells(RowNdx - 1, "A").Value Then
If Cells(RowNdx, "B").Value <= Cells(RowNdx - 1, "B").Value Then
Rows(RowNdx).Delete
End If
End If
Next RowNdx

End Sub

--
Regards

Roger Govier

In the interim while awaiting a vba solution from others ..

Here's a formulas way to get there ..
Assume source data in cols A and B, from row2 down
Using 3 empty cols to the right of the data

In E2:
=IF(SUMPRODUCT((A$2:A2=A2)*(B$2:B2=B2)*(A$2:A2<>"")*(B$2:B2<>""))>1,"",ROW(­))
Leave E1 blank

In F2:
=IF(ROW(A1)>COUNT($E:$E),"",INDEX(A:A,SMALL($E:$E,ROW(A1))))
Copy F2 to G2. Format G2 as date to taste. Select E2:G2, fill down to
last
row of source data. Cols F & G will return the required results all
neatly
bunched at the top. Freeze as values, then delete col E and source
cols as
may be desired.
--
Max
Singaporehttp://savefile.com/projects/236895
xdemechanik













- Show quoted text -

Thank you Max... this works a treat and is a great interim measure
until I can get the macro running.

 

[chevetteau]

Hi

Amending the code to the following works fine for me

Sub DeleteTheOldies()
Dim RowNdx As Long

For RowNdx = Range("A1").End(xlDown).Row To 2 Step -1
If Cells(RowNdx, "A").Value = Cells(RowNdx - 1, "A").Value Then
If Cells(RowNdx, "B").Value <= Cells(RowNdx - 1, "B").Value Then
Rows(RowNdx).Delete
End If
End If
Next RowNdx

End Sub

--
Regards

Roger Govier








Thank you Max... this works a treat and is a great interim measure
until I can get the macro running.- Hide quoted text -

- Show quoted text -

Hi Roger,

I apologise for taking so long to get back to you. This is exactly
what I am after. THANK YOU!!

Regards,

 

[chevetteau]

Hi

Amending the code to the following works fine for me

Sub DeleteTheOldies()
Dim RowNdx As Long

For RowNdx = Range("A1").End(xlDown).Row To 2 Step -1
If Cells(RowNdx, "A").Value = Cells(RowNdx - 1, "A").Value Then
If Cells(RowNdx, "B").Value <= Cells(RowNdx - 1, "B").Value Then
Rows(RowNdx).Delete
End If
End If
Next RowNdx

End Sub

--
Regards

Roger Govier








Thanks Roger - this is exactly what I was after.

 

[Roger Govier]

Hi

You're very welcome. Thanks for the feedback letting us know it worked
for you.

--
Regards

Roger Govier

Hi

Amending the code to the following works fine for me

Sub DeleteTheOldies()
Dim RowNdx As Long

For RowNdx = Range("A1").End(xlDown).Row To 2 Step -1
If Cells(RowNdx, "A").Value = Cells(RowNdx - 1, "A").Value Then
If Cells(RowNdx, "B").Value <= Cells(RowNdx - 1, "B").Value
Then
Rows(RowNdx).Delete
End If
End If
Next RowNdx

End Sub

--
Regards

Roger Govier








Thank you Max... this works a treat and is a great interim measure
until I can get the macro running.- Hide quoted text -

- Show quoted text -

Hi Roger,

I apologise for taking so long to get back to you. This is exactly
what I am after. THANK YOU!!

Regards,