Deleting old entries

artz

Well-known Member
Joined
Aug 11, 2002
Messages
791
The following code works fine if the data is grouped (not necessarily sorted) by column B (but not necessarily by column A), this code will delete the duplicates rows, but retaining the latest entry (by column A) of each name in column B.

Code:
Sub DeleteTheOldies()
Dim RowNdx As Long
For RowNdx = Range("B2").End(xlDown).Row To 2 Step -1
    If Cells(RowNdx, "B").Value = Cells(RowNdx - 1, "B").Value Then
        If Cells(RowNdx, "A").Value <= Cells(RowNdx - 1, "A").Value Then
            Rows(RowNdx).Delete
        Else
            Rows(RowNdx - 1).Delete
        End If
    End If
Next RowNdx

End Sub

Unfortunately, my data in column B is not grouped (don't want it necessarily) to retain the original order.

I would like the code to perform the function described above, i.e., delete the duplicates rows, but retaining the latest entry (by column A) of each name in column B without having the data grouped.

Also, I need at the same time to delete the same rows that are removed in columns C, D, and E?

Can the code be modified to do this?

Thanks,

Art
 

Some videos you may like

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.

Domenic

MrExcel MVP
Joined
Mar 10, 2004
Messages
19,406
Try...

Code:
Sub DeleteTheOldies()

Dim wf As WorksheetFunction
Dim LastRow As Long
Dim i As Long

Set wf = Application.WorksheetFunction
LastRow = Range("B2").End(xlDown).Row

Application.ScreenUpdating = False

For i = LastRow To 2 Step -1
    If wf.CountIf(Range(Cells(i, 1), Cells(LastRow, 1)), Cells(i, 1)) > 1 Then
            Rows(i).Delete
    End If
Next

Application.ScreenUpdating = True

End Sub
 

artz

Well-known Member
Joined
Aug 11, 2002
Messages
791
Hi Domenic,

Thanks for your posting and code. I did try your code and it didn't quite do what I had in mind. Below is and input and ouput for what I am looking for. Maybe that will help:

Code:
Input:
A                B      C      D       E
12/12/09	yyyy	 a	b	c
12/13/09	jjjj	 d	e	f
12/14/09	krr	 g	h	i
12/15/09	yyyy	 j	k	l
12/16/09	yyyy	 m	n	o
12/17/09	jjjj	 p	q	r
12/18/09	jjjj	 s	t	u
12/19/09	jjjj	 v	w	x
12/20/09	krr	 y	z	aa

Output:

12/16/09	yyyy	 m	n	o
12/19/09	jjjj	 v	w	x
12/20/09	krr	 y	z	aa

I apologize if using code tags this way is not suggested, however, it keeps the columns formatted to better illustrate what I need. :)

Please let me know if you have any questions.

Thanks,

Art
 

Domenic

MrExcel MVP
Joined
Mar 10, 2004
Messages
19,406
Try...

Code:
    If wf.CountIf(Range(Cells(i, [COLOR="Red"]2[/COLOR]), Cells(LastRow, [COLOR="red"]2[/COLOR])), Cells(i, [COLOR="red"]2[/COLOR])) > 1 Then
 

artz

Well-known Member
Joined
Aug 11, 2002
Messages
791

ADVERTISEMENT

Hi Domenic,

Thanks for your reply. I don't quite understand how to implement the code snippet that you posted. Could you provide more details? I think that you are suggesting that the code be added to your previous post. If that's the case, I don't know how it fits in.

Thanks,

Art
 

artz

Well-known Member
Joined
Aug 11, 2002
Messages
791
Hi Domenic,

I guess that I should wait until I fully wake up before I post. Your code snippet placed in your previous code works perfectly. :)

Thanks so much,

Art
 

Domenic

MrExcel MVP
Joined
Mar 10, 2004
Messages
19,406

ADVERTISEMENT

You're very welcome!
 

artz

Well-known Member
Joined
Aug 11, 2002
Messages
791
Domenic,

Yikes, I just deleted the wrong stuffwhen I ran your code. :(. The data that need to be deleted are on Sheet2 not Sheet1.

Could you modify your code to operate on Sheet2's data, not Sheet1?

Thanks,

Art
 

artz

Well-known Member
Joined
Aug 11, 2002
Messages
791
Domenic,

I tried modifying your code to operate on Sheet2 instead of Sheet1. When I run it, I get an error 400.

Do you see what's wrong?

Code:
Sub DeleteTheOldies()

Dim wf As WorksheetFunction
Dim LastRow As Long
Dim i As Long

Set wf = Application.WorksheetFunction
LastRow = Sheet2.Range("B2").End(xlDown).Row

Application.ScreenUpdating = False

For i = LastRow To 2 Step -1
    If wf.CountIf(Sheet2.Range(Cells(i, 2), Cells(LastRow, 2)), Cells(i, 2)) > 1 Then
            Rows(i).Delete
    End If
Next

Application.ScreenUpdating = True

End Sub

Thanks,

Art
 

Domenic

MrExcel MVP
Joined
Mar 10, 2004
Messages
19,406
Try...

Code:
Sub DeleteTheOldies2()

Dim wf As WorksheetFunction
Dim LastRow As Long
Dim i As Long

Set wf = Application.WorksheetFunction
LastRow = Worksheets("Sheet2").Range("B2").End(xlDown).Row

Application.ScreenUpdating = False

For i = LastRow To 2 Step -1
    With Worksheets("Sheet2")
        If wf.CountIf(Range(.Cells(i, 2), .Cells(LastRow, 2)), .Cells(i, 2)) > 1 Then
            .Rows(i).Delete
        End If
    End With
Next

Application.ScreenUpdating = True

End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,122,719
Messages
5,597,741
Members
414,171
Latest member
12Rev79

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top