# Thread: find and move the duplicate values in another sheet

1. ## 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

2. 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

3. I find it easier with the code as I have several files that must

4. 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
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```

#### Posting Permissions

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