Move or Copy Duplicate Rows to Difference Sheet

[Vgabond]

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 :-



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?

[Gary's Student]

You are running out of memory because you are creating massive arrays in VBA when capturing and copying UsedRange. You may need to process one row at a time.

[Vgabond]

You are running out of memory because you are creating massive arrays in VBA when capturing and copying UsedRange. You may need to process one row at a time.

Hi Gary

I have 800K lines to work with so you suggesting the criteria should be use one at a time? Any ideas? and maybe you could ammend some of the script to make it work?

[Admin]

Hi,

Could you post a sample workbook with the new criteria added ?