Pulling duplicate data from multiple worksheets

Smoo

New Member
Joined
Sep 15, 2006
Messages
9
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.

:rolleyes:

Thank you,
SMOO
 

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.

agihcam

Well-known Member
Joined
Jan 16, 2006
Messages
1,624
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

New Member
Joined
Sep 15, 2006
Messages
9
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

MrExcel MVP
Joined
Aug 21, 2004
Messages
16,995
Hi
try
Code:
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

Well-known Member
Joined
Jan 16, 2006
Messages
1,624

ADVERTISEMENT

Thanks Jindon.
tried your code but got syntax error here;
Code:
Set wsDup = Sheets.Add before:=Sheets(1)
i've fixed it with;
Code:
Set wsDup = Sheets.Add(before:=Sheets(1))

and a typo error here;
Code:
With CreateObject("Scripting.Dictionray")

and object required here;
Code:
        a = ws.Range("a1", ws.Range("a" & Rwos.Count).End(xlUp)).Value
 

agihcam

Well-known Member
Joined
Jan 16, 2006
Messages
1,624

ADVERTISEMENT

one more, type mismatch here;
Code:
For Each e In a
 

agihcam

Well-known Member
Joined
Jan 16, 2006
Messages
1,624
yeah!

revised code got a type mismatch here;

Code:
ReDim Preserve myDup(1 To n)
 

Forum statistics

Threads
1,141,681
Messages
5,707,792
Members
421,527
Latest member
Tamiwsw

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top