Removing duplicates values via VBA

[jmazorra]

Hello folks:

I have the following spreadsheet:

[TABLE="width: 514"]
<tbody>[TR]
[TD]Where[/TD]
[TD]Who[/TD]
[TD]Time[/TD]
[TD]CardNum[/TD]
[/TR]
[TR]
[TD]Building 2  Entry A[/TD]
[TD]Smith, Brian[/TD]
[TD="align: right"]6:52:00[/TD]
[TD="align: right"]2498[/TD]
[/TR]
[TR]
[TD]Building 2  Entry A[/TD]
[TD]Smith, Brian[/TD]
[TD="align: right"]8:33:00[/TD]
[TD="align: right"]2498[/TD]
[/TR]
[TR]
[TD]Building 2  Entry A[/TD]
[TD]Smith, Brian[/TD]
[TD="align: right"]7:38:00[/TD]
[TD="align: right"]2498[/TD]
[/TR]
[TR]
[TD]Building 2  Entry A[/TD]
[TD]Doe, John[/TD]
[TD="align: right"]11:59:00[/TD]
[TD="align: right"]41880[/TD]
[/TR]
[TR]
[TD]Building 2  Entry A[/TD]
[TD]Doe, John[/TD]
[TD="align: right"]17:23:00[/TD]
[TD="align: right"]41880[/TD]
[/TR]
[TR]
[TD]Building 2  Entry A[/TD]
[TD]Miller, Juan[/TD]
[TD="align: right"]6:54:00[/TD]
[TD="align: right"]13350[/TD]
[/TR]
[TR]
[TD]Building 2  Entry A[/TD]
[TD]Miller, Juan[/TD]
[TD="align: right"]14:26:00[/TD]
[TD="align: right"]13350[/TD]
[/TR]
</tbody>[/TABLE]

I am trying to remove all duplicate entries and leave only the earliest occurence on column Time, so my data would look like this:

[TABLE="width: 514"]
<tbody>[TR]
[TD]Where[/TD]
[TD]Who[/TD]
[TD]Time[/TD]
[TD]CardNum[/TD]
[/TR]
[TR]
[TD]Building 2  Entry A[/TD]
[TD]Smith, Brian[/TD]
[TD="align: right"]6:52:00[/TD]
[TD="align: right"]2498[/TD]
[/TR]
[TR]
[TD]Building 2  Entry A[/TD]
[TD]Doe, John[/TD]
[TD="align: right"]11:59:00[/TD]
[TD="align: right"]41880[/TD]
[/TR]
[TR]
[TD]Building 2  Entry A[/TD]
[TD]Miller, Juan[/TD]
[TD="align: right"]6:54:00[/TD]
[TD="align: right"]13350[/TD]
[/TR]
</tbody>[/TABLE]

I have thousands of rows so I can't really do it by hand, the Remove Duplicates command does not really work for me.

Any help will be appreciated.

 

[Richard U]

Sub Macro2()
'
    ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Add Key:=Range("A2:A8"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Add Key:=Range("B2:B8"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Add Key:=Range("C2:C8"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet2").Sort
        .SetRange Range("A1:D8")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveSheet.Range("$A$1:$D$8").RemoveDuplicates Columns:=Array(1, 2, 4), _
        Header:=xlYes
    Range("E13").Select
End Sub