vba code to find Duplicate Values and Newest date(Max) date in the Corresponding Column(ce

Friends i'm Creating Macro for "Locating Duplicate values in a Column n new date(Max date in Corresponding column)....i'm not Getting Logic for that pls Help me in the Coding...

i Data is like this

x y Result
3 8/6/2013 8/6/2013
3 8/5/2013
3 8/4/2013
2 9/3/2013 9/2/2013
2 9/2/2013
2 9/1/2013
1 9/6/2013 9/6/2013
1 9/3/2013
1 9/2/2013
i tried this by sorting..its Working Better for Small Data..but not for Large... Even i Want to Reduce the code Length..
Here is My code...

    

Sub Macro2()

Range("a1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Name = "fstcol"
Range("b1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Name = "seccol"
Range("a1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
 Selection.Name = "myrange"
 Range("a1").Select
 Range("myrange").Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("fstcol") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("seccol") _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("myrange")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    Range("a1").End(xlToRight).Offset(0, 1).Value = "Flag"
    Range("a1").End(xlToRight).Offset(1, 0).Select
    ActiveCell.Value = 1
    Do While ActiveCell.Offset(0, -2).Value <> "" And ActiveCell.Offset(1, -2).Value <> ""
     ActiveCell.Offset(1, 0).Select
If ActiveCell.Offset(0, -2).Value = ActiveCell.Offset(1, -2).Value Then
           ActiveCell.Value = ActiveCell.Offset(-1, 0).Value + 1
    End If
    Loop
    Range("a1").End(xlToRight).Offset(1, 0).Select
    Do While ActiveCell.Offset(0, -2).Value <> ""
    If ActiveCell.Value = 1 Then
    ActiveCell.Value = ActiveCell.Offset(0, -1).Value
    Else: ActiveCell.Value = ""
    End If
    ActiveCell.Offset(1, 0).Select
    Loop
    ActiveCell.EntireColumn.Select
    Selection.NumberFormat = "m/d/yyyy"
    Range("a1").Select
End Sub

no need for such complicated macro no need for sorting etc
get uniuq values in x below the data and loop through the uniuq x values and use mim if formula

see below my macro

Sub test()
    Dim x As Range, filt As Range, cfilt As Range, myformula As String

    Range(Range("A1").End(xlDown).Offset(1, 0), Cells(Rows.Count, "A")).EntireRow.Delete

    Set filt = Range("A1").End(xlDown).Offset(5, 0)
    Set x = Range(Range("A1"), Range("A1").End(xlDown))
    x.AdvancedFilter xlFilterCopy, , filt, True
    Set filt = filt.Offset(1, 0).Resize(filt.CurrentRegion.Rows.Count - 1)
    'MsgBox filt.Address
    For Each cfilt In filt
        myformula = "=MAX(IF(" & x.Address & "=" & cfilt & "," & x.Offset(0, 1).Address & "))"
        cfilt.Offset(0, 1) = Application.Evaluate(myformula)
        cfilt.Offset(0, 1).NumberFormat = "m/d/yyyy"
    Next cfilt
End Sub