Delete extra rows using VBA

Hello All,

I have tried autofilter, but it still doesn't work for this project.

I am trying to find the next exact ocurrence in Column A, then I want to look in Column C and get the latest date and delete the extras not needed. The worksheet is over 53,000 rows long.

Here is a sample of the data:

A B C
StateStreetBankBook.mdb 27328512 01/01/1980 18:00:00 CST
Surplus.mdb 712704 01/01/1980 18:00:00 CST
susan_martin.mdb 13627392 01/01/1980 18:00:00 CST
TAC Report 2005.mdb 23988224 01/01/1980 18:00:00 CST
TestCase.mdb 15501312 01/01/1980 18:00:00 CST
Video Collection1.mdb 475136 01/01/1980 18:00:00 CST
aoglog.mdb 561152 01/01/1980 18:17:32 CST
PROJ1802.MDB 260096 01/01/1997 06:25:34 CST
PROJ1802.MDB 260096 01/01/1997 07:25:34 CST
Proj1802.mdb 260096 01/01/1997 07:25:34 CST
PROJ1802.MDB 260096 01/01/1997 07:25:34 CST


Note there are 4 proj1802.mdb files and there are 3 with the same date and time. I just want one of these.

There are many other files with different dates and times.

I am using this for an Audit Trail.

Can someone help me on this? It is starting to drive me nuts!

Thanks in advance for any advice.

Kurt

Kurt

Assuming your data is on sheet1, with headings in row 1, and sheet2 exists in your workbook, then try

Sub aaa()
  Dim OutSH As Worksheet, DataSH As Worksheet
  Set OutSH = Sheets("Sheet2")
  Set DataSH = Sheets("Sheet1")
  OutSH.Range("A1:C1").Value = DataSH.Range("A1:C1").Value
  DataSH.Range("A1").CurrentRegion.AdvancedFilter action:=xlFilterCopy, copytorange:=OutSH.Range("A1:C1"), unique:=True
  With OutSH
    .Range("A1").CurrentRegion.Sort key1:=.Range("A1"), order1:=xlAscending, key2:=.Range("C1"), order2:=xlDescending, header:=xlYes
    For i = .Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
      If WorksheetFunction.CountIf(.Range("A:A"), .Cells(i, 1).Value) > 1 Then .Cells(i, 1).EntireRow.Delete
    Next i
  End With
End Sub

HTH

rylo