Delete rows based on certain criteria

[Guest]

I would like to keep the most current data in each row (based on column 'f')
where column 'a' equals column 'b'. In the following, row 1, row 6, and row
8 would be kept. The remaining rows would be deleted.

a b c d e f
1 BAC-390 1 MA09385 CP M11134 1/17/2006
2 BAC-390 1 MA08763 CP M9494 10/28/2005
3 BAC-390 1 MA07924 CP M7505 7/30/2005
4 BAC-390 1 MA07328 CP M6345 6/1/2005
5 BAC-390 2 MA07681 CP M6921 7/1/2005
6 BAC-390 3 MA09109 CP M10158 12/3/2005
7 BAC-390 3 MA08196 CP M8117 8/26/2005
8 BAC-390 2 MA08837 CP M9560 11/1/2005
9 BAC-390 2 MA06685 CP M7077 7/12/2005

I found the following procedure for what was described as "Here's another
procedure that may be useful. Suppose you have two columns of data -- column
A containing some names, and column B containing some dates. If the data is
grouped (not necessarily sorted) by column A (but not necessarily by column
B), this code will delete the duplicates rows, but retaining the latest entry
(by column B) of each name in column A"

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
Else
Rows(RowNdx - 1).Delete
End If
End If
Next RowNdx
End Sub

I do not really understand this procedure and it also only looking at one
column of data to distinguish duplicates.

Any help is really appreciated!!! Thank you!!

 

[Guest]

Assuming that you don't have a header row, try this:

Press Ctrl and F11 to open the Visual Basic Editor.
Select Insert and then Module.
Copy the code below and paste it into the module.
Close the Editor.
Go to Tools > Macro > Macros…
Highlight the macro and click Run.

---------------------------------

Option Explicit
Sub DeleteDupes()
Dim Iloop As Integer
Dim Numrows As Integer

'Turn off warnings, etc.
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Numrows = Range("A65536").End(xlUp).Row
Range("A1:F" & Numrows).Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, _
Key2:=Range("B1"), Order2:=xlAscending, Key3:=Range("F1"), _
Order3:=xlDescending, Header:=xlNo, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
For Iloop = Numrows To 2 Step -1
If Cells(Iloop, "A") & Cells(Iloop, "B") = Cells(Iloop - 1, "A") & _
Cells(Iloop - 1, "B") Then
Rows(Iloop).Delete
End If
Next Iloop

Range("A1").Select

'Turn on warnings, etc.
Application.DisplayAlerts = True
Application.ScreenUpdating = True


End Sub

 

[Guest]

Thanks Ken!!

Assuming that you don't have a header row, try this:

Press Ctrl and F11 to open the Visual Basic Editor.
Select Insert and then Module.
Copy the code below and paste it into the module.
Close the Editor.
Go to Tools > Macro > Macros…
Highlight the macro and click Run.

---------------------------------

Option Explicit
Sub DeleteDupes()
Dim Iloop As Integer
Dim Numrows As Integer

'Turn off warnings, etc.
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Numrows = Range("A65536").End(xlUp).Row
Range("A1:F" & Numrows).Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, _
Key2:=Range("B1"), Order2:=xlAscending, Key3:=Range("F1"), _
Order3:=xlDescending, Header:=xlNo, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
For Iloop = Numrows To 2 Step -1
If Cells(Iloop, "A") & Cells(Iloop, "B") = Cells(Iloop - 1, "A") & _
Cells(Iloop - 1, "B") Then
Rows(Iloop).Delete
End If
Next Iloop

Range("A1").Select

'Turn on warnings, etc.
Application.DisplayAlerts = True
Application.ScreenUpdating = True


End Sub