remove duplicate records based on most recent date

I have a set of inventory records (84,000 user workstations) that have some duplicate records (~2%). The database is suppose to have a single record per workstation (unique ID). Each record has a date associated with it, and the duplicate records each have a different date. I need to keep the most recent record (based on date) and discard the duplicate records with the old dates.

Please attach a sample workbook so we can help you faster.

Use this code -

Option Explicit
Dim lrow As Long
Dim i As Long

Sub sort_latest()

ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A:A") _
    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("C:C") _
    , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
    .SetRange Range("A:D")
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

With Worksheets("Sheet1")
    lrow = .Range("A" & Rows.Count).End(xlUp).Row
    For i = lrow To 2 Step -1
        If .Range("A" & i).Value = .Range("A" & i - 1).Value Then
            If .Range("C" & i).Value < .Range("C" & i - 1).Value Then
                .Rows(i & ":" & i).Delete
                lrow = lrow - 1
            End If
        End If
    Next i
End With

End Sub

I am not very fluent in complicated formulae, but can provide a solution with VBA.

All you have to do is press Alt+F11, you will get a code window. On the left hand side, you will see Microsoft excel objects. Right click and select insert -> Module. Copy the above code into that module. Go back to your excel sheet, select View -> Macros and select the macro to be run.

Try this

Option Explicit
Dim lrow As Long
Dim i As Long

Sub sort_latest()

ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("D:D") _
    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("H:H") _
    , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
    .SetRange Range("A:H")
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

With Worksheets("Sheet1")
    lrow = .Range("A" & Rows.Count).End(xlUp).Row
    For i = lrow To 2 Step -1
        If .Range("D" & i).Value = .Range("D" & i - 1).Value Then
            If .Range("H" & i).Value < .Range("H" & i - 1).Value Then
                .Rows(i & ":" & i).Delete
                lrow = lrow - 1
            End If
        End If
    Next i
End With

End Sub

A subscript out of range error is related to the sheet names in the code not matching with the sheet names in the file. Ensure that the sheet names match and then run the code. It should work.

taps135,

Unfortunately you need to post your question in a new thread, it's against the forum rules to post a question in the thread of another user. If you create your own thread, any advice will be tailored to your situation so you should include a description of what you've done and are trying to do. Also, if you feel that this thread is particularly relevant to what you are trying to do, you can surely include a link to it in your new thread.

taps135,

You are pursuing your question here http://www.excelforum.com/excel-form...test-date.html so dont discuss it in this thread. You are duplicating efforts.