Results 1 to 4 of 4

Thread: Move or Copy Duplicate Rows to Difference Sheet

  1. #1
    Junior Member
    Join Date
    Dec 2012
    Posts
    2
    Rep Power
    0

    Move or Copy Duplicate Rows to Difference Sheet

    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?

  2. #2
    Junior Member
    Join Date
    Dec 2012
    Posts
    6
    Rep Power
    0
    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.

  3. #3
    Junior Member
    Join Date
    Dec 2012
    Posts
    2
    Rep Power
    0
    Quote Originally Posted by Gary's Student View Post
    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?

  4. #4
    Administrator Admin's Avatar
    Join Date
    Mar 2011
    Posts
    1,123
    Rep Power
    10
    Hi,

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

    Excel Range to BBCode Table
    Use Social Networking Tools If You Like the Answers !

    Message to Cross Posters

    @ Home - Office 2010/2013/2016 on Win 10 (64 bit); @ Work - Office 2016 on Win 10 (64 bit)

Similar Threads

  1. Move data from rows into columns for every unique value
    By mahmoud-lee in forum Excel Help
    Replies: 4
    Last Post: 06-13-2013, 03:02 AM
  2. Replies: 1
    Last Post: 05-19-2013, 02:37 PM
  3. Macro Copy Columns and Paste in rows.
    By TommyKris in forum Excel Help
    Replies: 3
    Last Post: 03-06-2013, 02:36 PM
  4. Replies: 1
    Last Post: 02-10-2013, 06:21 PM
  5. Replies: 2
    Last Post: 12-26-2012, 08:31 AM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •