Pulling duplicate data from multiple worksheets

[Smoo]

Good Afternoon,

I would like to know how to create a macro to search multiple worksheets in a workbook and compile all the duplicates into a report on a separate worksheet. The data in each worksheet is formated the same way:
A B C D
Name Date Time Reason

The names in the A column are what the macro would need to go on to look for duplicates.



Thank you,
SMOO

 

[agihcam]

Hi -

Welcome to Mr. Excel Board.

Does it mean duplicate from any of the worksheet? say you have name John on the first WS and on the 2nd sheet, is it considered duplicates?

 

[Smoo]

Thank you for responding. You are correct; I would like it to pull a duplicate from all worksheets including the first one (original).

Thank you,

SMOO

 

[jindon]

Hi
try

Sub test()
Dim ws As Worksheet, wsDup As Worksheet, a, e, myDup(), n As Long
With CreateObject("Scripting.Dictionary")
    .CompareMode = vbTextCompare
    For Each ws In Worksheets
        a = ws.Range("a1",ws.Range("a" & Rows.Count).End(xlUp)).Value
        If Not IsArry(a) Then
            If Not IsEmpty(a) Then
                If Not .exists(a) Then
                    .add a, Empty
                Else
                    n = n + 1
                    ReDim Preserve myDup(1 To n)
                    myDup(n) = a
               End If
               GoTo Next_ws
            End If
        End If
        For Each e In a
            If Not IsEmpty(e) Then
                If Not .exists(e) Then
                     .add e, Empty
                Else
                     If IsEmpty(.item(e)) Then
                         n = n + 1
                         ReDim Preserve myDup(1 To n)
                         myDup(n) = e
                         .item(e) = 1
                     End If
                End If
             End If
         Next
Next_ws:
    Next
End With
On Error Resume Next
Sheets("dups").Delete
On Error GoTo 0
Set wsDup = Sheets.Add(before:=Sheets(1))
wsDup.Name = "dups"
wsDup.Range("a1").Resize(n).Value = Application.Transpose(myDup)
Set wsDup = Nothing
End Sub

 

[agihcam]

Thanks Jindon.
tried your code but got syntax error here;

Set wsDup = Sheets.Add before:=Sheets(1)

i've fixed it with;

Set wsDup = Sheets.Add(before:=Sheets(1))

and a typo error here;

With CreateObject("Scripting.Dictionray")

and object required here;

        a = ws.Range("a1", ws.Range("a" & Rwos.Count).End(xlUp)).Value

 

[jindon]

Thanks, agihcam

fixed the code...

 

[agihcam]

one more, type mismatch here;

For Each e In a

 

[jindon]

one more, type mismatch here;

For Each e In a

Are you refering to the empty sheet?

code fixed

 

[agihcam]

yeah!

revised code got a type mismatch here;

ReDim Preserve myDup(1 To n)