Duplicates

[jillibillijames]

Hi,

I have thousands of records in the first column of every sheet (6 sheets) and there are many duplicates.
I want to get all the unique records from all the sheets to be pasted in one sheet. I used advance filter but i need to repeat for every sheet and club all sheets data in one sheet and again repeat the same.

Can anyone please help me.
Thanks in Advance.

 

[Sektor]

Try this code (Office 2007/2010).

Sub FF()

    Dim i As Integer, rngUnion As Range
    
    For i = 1 To 6
        With Worksheets(i)
            .Columns("A:A").RemoveDuplicates
            Set rngUnion = Union(rngUnion, .Range("A1", .Range("A1").End(xlDown))
        End With
    Next
    
    rngUnion.Copy
    Sheets.Add.Paste
    
End Sub

 

[jillibillijames]

Hi,

I have tried the above code but dint get the expected output.

Can you please help me with any other code.

Thanks in Advance

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG30May53
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] ws [COLOR="Navy"]As[/COLOR] Worksheet
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
    .CompareMode = vbTextCompare
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] ws [COLOR="Navy"]In[/COLOR] Worksheets
       [COLOR="Navy"]With[/COLOR] Sheets(ws.Name)
                [COLOR="Navy"]Set[/COLOR] Rng = .Range(.Range("A1"), .Range("A" & Rows.Count).End(xlUp))
            [COLOR="Navy"]End[/COLOR] With
                [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
                    [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR] .Add Dn.Value, ""
                [COLOR="Navy"]Next[/COLOR] Dn
       [COLOR="Navy"]Next[/COLOR] ws
Sheets.Add(after:=Sheets(Sheets.Count)).Name = "Master"
ActiveSheet.Range("A1").Resize(.Count) = Application.Transpose(.Keys)
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Sektor]

Try this one. Your 6 sheets must be first six sheets.

Sub G()
    
    Dim i As Integer, sh As Worksheet
    
    Set sh = Sheets.Add(After:=Sheets(Sheets.Count))
    
    For i = 1 To 6
        With Worksheets(i)
            .Columns("A:A").RemoveDuplicates
            .Range("A1").CurrentRegion.Copy sh.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
        End With
    Next

    sh.Activate
    
End Sub

 

[Peter_SSs]

jillibillijames

It is not clear to me whether the duplicate need to be removed from each sheet then the results transferred to the new sheet or whether all values need to be moved to the new sheet then the duplicates removed. My code is for the latter, and also assumes Excel 2007 or later. (I'm also unsure whether there are headers in each sheet)

<font face=Courier New><br><SPAN style="color:#00007F">Sub</SPAN> UniqueList()<br>    <SPAN style="color:#00007F">Dim</SPAN> ws <SPAN style="color:#00007F">As</SPAN> Worksheet<br>    <SPAN style="color:#00007F">Dim</SPAN> i <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <br>    <SPAN style="color:#00007F">Set</SPAN> ws = Sheets.Add(After:=Sheets(Sheets.Count))<br>    <SPAN style="color:#00007F">For</SPAN> i = 1 <SPAN style="color:#00007F">To</SPAN> 6<br>        <SPAN style="color:#00007F">With</SPAN> Sheets(i)<br>            .Range("A1", .Range("A" & .Rows.Count).End(xlUp)).Copy Destination:=ws.Range("A" & ws.Rows.Count).End(xlUp).Offset(1)<br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>    <SPAN style="color:#00007F">Next</SPAN> i<br>    <SPAN style="color:#00007F">With</SPAN> ws.Columns("A")<br>        .SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp<br>        .RemoveDuplicates Columns:=1, Header:=xlNo<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>End <SPAN style="color:#00007F">Sub</SPAN><br></FONT>

 

[jillibillijames]

Thanks All...