Results 1 to 4 of 4
  1. #1
    New Lounger
    Join Date
    Feb 2014
    Posts
    2
    Thanks
    0
    Thanked 0 Times in 0 Posts

    find and move the duplicate values in another sheet

    Hello,

    I have a file with many values, distributed across multiple columns.

    From sheet1 i want to find and move all the duplicate values in the sheet 2

    and I need a macro,a code macro to work at the level of the sheets, Sheet1-Sheet2

    I want to move cut/paste all values duplicates 2 times 3 times or how many times is found
    from sheet1, in sheet2 the results to be made in columns A and B

    in sheet 1 to remain single value, only the values themselves which didn't pair
    I mean if a value is 2 times
    to move the original value
    but and double found

    .................................................. ..
    or please change the code below
    This code works
    should be amended as a result put them in columns A and B.


    Code:
    Sub ertert() 
        Dim x, y(), i&, j&, t(), bu As Boolean 
        x = Sheets("Foaie1").Range("A2").CurrentRegion.Value 
        Redim y(1 To UBound(x), 1 To UBound(x, 2)) 
        With CreateObject("Scripting.Dictionary") 
            .CompareMode = 1 
            For i = 1 To UBound(x) 
                For j = 1 To UBound(x, 2) 
                    If Len(x(i, j)) Then 
                        If .Exists(x(i, j)) Then 
                            t = .Item(x(i, j)): bu = True 
                            y(t(0), t(1)) = x(i, j): y(i, j) = x(i, j) 
                            x(i, j) = "": x(t(0), t(1)) = "" 
                        Else 
                            .Item(x(i, j)) = Array(i, j) 
                        End If 
                    End If 
                Next j 
            Next i 
        End With 
        Sheets("Foaie1").Range("A2").Resize(i - 1, j - 1).Value = x 
        If bu Then Sheets("Foaie2").Range("A2").Resize(i - 1, j - 1).Value = y() 
    End Sub
    Thank you
    Attached Files Attached Files

  2. Get our unique weekly Newsletter with tips and techniques, how to's and critical updates on Windows 7, Windows 8, Windows XP, Firefox, Internet Explorer, Google, etc. Join our 480,000 subscribers!

    Excel 2013: The Missing Manual

    + Get this BONUS — free!

    Get the most of Excel! Learn about new features, basics of creating a new spreadsheet and using the infamous Ribbon in the first chapter of Excel 2013: The Missing Manual - Subscribe and download Chapter 1 for free!

  3. #2
    Super Moderator
    Join Date
    Jan 2001
    Location
    Melbourne, Victoria, Australia
    Posts
    3,520
    Thanks
    3
    Thanked 143 Times in 136 Posts
    Is this an assignment where you need to learn about dictionary objects and arrays or is this a real task?

    You can do this without macros by putting all the entries into a single column and then using a pivot table to display all the entries with a single instance or those with multiple entries.

    If you want a VBA solution then forget the array and stick with a dictionary object but do two passes of the source cells.
    First pass builds entries for each key and increments the value with the number of hits.
    Second pass checks the dictionary value and if > 1 deletes cell contents
    Finally, step though the dictionary and the keys to Foaie2 if its value > 1
    Andrew Lockton, Chrysalis Design, Melbourne Australia

  4. #3
    New Lounger
    Join Date
    Feb 2014
    Posts
    2
    Thanks
    0
    Thanked 0 Times in 0 Posts
    I find it easier with the code as I have several files that must

  5. #4
    Super Moderator
    Join Date
    Jan 2001
    Location
    Melbourne, Victoria, Australia
    Posts
    3,520
    Thanks
    3
    Thanked 143 Times in 136 Posts
    Try this
    Code:
    Sub v1()
      Dim aCell, aKey, iOffset
      Dim myCount As Scripting.dictionary
      Set myCount = New Scripting.dictionary
      For Each aCell In Sheets("Foaie1").Range("A2").CurrentRegion.Cells
        If myCount.exists(aCell.Value) Then
          myCount(aCell.Value) = myCount(aCell.Value) + 1
        Else
          myCount.Add aCell.Value, 1
        End If
      Next aCell
      
      For Each aCell In Sheets("Foaie1").Range("A2").CurrentRegion.Cells
        If myCount(aCell.Value) > 1 Then
          aCell.Value = ""
        End If
      Next aCell
      
      iOffset = 0
      For Each aKey In myCount.Keys
        If myCount(aKey) > 1 Then
          Sheets("Foaie2").Range("A2").Offset(iOffset, 0).Value = aKey
          Sheets("Foaie2").Range("A2").Offset(iOffset, 1).Value = myCount(aKey)
          iOffset = iOffset + 1
        End If
      Next aKey
    End Sub
    Andrew Lockton, Chrysalis Design, Melbourne Australia

Posting Permissions

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