VBA code to find duplicates and paste on another sheet

[miraclious]

Hi I need to find duplicates across about 15 sheets in a workbook. But my code can only reach 2 sheets. Need help to change the code:

Sub GetDups()
Dim myCount As Long
Dim Rng1 As Range, Rng2 As Range, C As Range
myCount = 0
Set Rng1 = Worksheets("Sheet1").Range("A1:A100")
Set Rng2 = Worksheets("Sheet2").Range("A1:A100")
For Each C In Rng1
If WorksheetFunction.CountIf(Rng2, C) Then
myCount = WorksheetFunction.CountIf(Rng2, C) + myCount
With Worksheets("Sheet3")
.Cells(myCount, 1).Value = C
End With
End If
Next C
End Sub


Thank you

 

[DanteAmor]

Hi and welcome to MrExcel!

What is the comparison you want to make?
Sheet1 with sheet2, sheet1 with sheet3, sheet1 with sheet4 and so on up to sheet15?
Or do you want to know if there are duplicates of all against all sheets?

 

[miraclious]

Hello! Thank you! I want to comparison against all sheets

 

[DanteAmor]

If you have the following values on each sheet:

Dante Amor
	A
1	val1
2	val2
3	val3
4	val4
5	val5
6	val6
7	val7
8	val8
9	val9
10	val10
Sheet1

Dante Amor
	A
1
2	val2
3
4	val4
5
6	val6
Sheet2

Dante Amor
	A
1	val3
2	val6
3	val9
Sheet3

Dante Amor
	A
1	val4
2	val6
3	val10
Sheet4

The result in the sheet "Results" (you must create a sheet with this name):

Dante Amor
	A	B
1
2	val2	Sheet1|Sheet2
3	val3	Sheet1|Sheet3
4	val4	Sheet1|Sheet2|Sheet4
5	val6	Sheet1|Sheet2|Sheet3|Sheet4
6	val9	Sheet1|Sheet3
7	val10	Sheet1|Sheet4
Results

In column A the value and in column B the sheets where it is duplicated. Values that are not duplicates simply do not appear in the result.

Try this.

Sub comparison_against_all_sheets()
  Dim shR  As Worksheet, sh As Worksheet
  Dim dic As Object, ky As Variant, v As Variant
  Dim i As Long
  
  Set shR = Sheets("Results")   'Sheet with the results
  shR.Cells.ClearContents
  Set dic = CreateObject("Scripting.Dictionary")
  
  For Each sh In Sheets
    If sh.Name <> shR.Name Then
      For i = 1 To sh.Range("A" & Rows.Count).End(3).Row
        v = sh.Range("A" & i).Value
        If v <> "" Then
          If Not dic.exists(v) Then dic(v) = sh.Name Else dic(v) = dic(v) & "|" & sh.Name
        End If
      Next
    End If
  Next
  
  For Each ky In dic.keys
    If InStr(1, dic(ky), "|") > 0 Then
      shR.Range("A" & Rows.Count).End(3)(2).Resize(1, 2).Value = Array(ky, dic(ky))
    End If
  Next
End Sub