Hi Guys

I'm new here. Anyway let's go straight to the above matter. I have below macro from Kris ( Krishnakumar ) which I believe he is also a Moderator or something here. Anyway the script that he gave me , was perfect at that point of time but I have another issue now. I am currently using Excel 2010 and I have a data that goes up to 856756 lines where I need to check for duplicate and maintain only unique numbers. There's another criteria where the unique number should based on the condition where the Active Date will be the latest date. Script that provided by Kris as below :-

Code:
Sub kTest_v2()
Dim ka, k(), q(), n As Long, i As Long, c As Long, j As Long

With ActiveSheet
    ka = .UsedRange
    ReDim k(1 To UBound(ka, 1), 1 To UBound(ka, 2))
    ReDim q(1 To UBound(ka, 1), 1 To UBound(ka, 2))
    With CreateObject("scripting.dictionary")
        For i = UBound(ka, 1) To 2 Step -1
            If ka(i, 4) <> vbNullString Then
                If Not .exists(LCase$(ka(i, 4))) Then
                    n = n + 1:
                    For c = 1 To UBound(ka, 2): k(n, c) = ka(i, c): Next
                    .Add LCase$(ka(i, 4)), Nothing
                Else
                    j = j + 1
                    For c = 1 To UBound(ka, 2): q(j, c) = ka(i, c): Next
                End If
            End If
        Next
    End With
    If n > 0 Then
        .Cells(2, 1).Resize(UBound(ka, 1) - 1, UBound(ka, 2)).ClearContents
        .Cells(2, 1).Resize(n, UBound(ka, 2)).Value = k
    End If
End With
MsgBox j
If j > 0 Then
    With Sheets("Sheet2") '<== adjust to suit
        .Cells(1).Resize(, UBound(ka, 2)).Value = Application.Index(ka, 1, 0)
        .Cells(2, 1).Resize(j, UBound(ka, 2)).Value = q
    End With
End If
End Sub
My issues with the above code is, when I use it, there will be an error prompt "Run time Error = 7" " Out of Memory" . Anyone have an ideas on how to solve this?