copy and remove duplicates

    there is a long list of data in column C sheet1
    how can i copy that column to sheet2 column C by removing duplicate entries


    The code that I have is


    Code
    sheet1.Range("C5" & sheet1.Range("C" & Rows.Count).End(xlUp).Row).Copy
sheet2.Range("C5").pastespecial
sheet2.Range("C5:C" & Range("C" & Rows.Count).End(xlUp).Row).RemoveDuplicates Columns:=1, Header:=xlNo


    What happens is that if I am having 1500 or more entries, the entire 1500 entries is first copied and then duplicates removed.


    What I am looking for is a fast VBA code to copy but not duplicates so that 1500 entries are not copied but only single entries.
    The origional sheet1 entry should not be changed.

    Re: copy and remove duplicates


    Hi Skamat,


    This can be done using advanced Filter option.


    Sheets(1).Range("C5:C" & row_Index).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets(2).Range("F5"), Unique:=True


    Hope this helps.


    Thanks,
    Kumar.
    Officetricks.com - Excel VBA Tips and Tricks Blogs

    Re: copy and remove duplicates


    Hi Skamat,


    I missed the calculation step for row_index. Please include this code, I have tested this in your sample excel document.

    Code
    row_Index = Sheets(1).Range("C" & Rows.Count).End(xlUp).Row
Sheets(1).Range("C5:C" & row_Index).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets(2).Range("F5"), Unique:=True


    Thanks,
    Kumar.
    OfficeTricks.com - Excel VBA Tips and Tricks Blogs

    Re: copy and remove duplicates


    your code works perfectly fine with minor modification needed


    If you see sheet1 has letter "a" appearing 5 times and after your code is run the letter "a" appears 2 times in sheet2 instead of 1 time.


    I tried with different alphebets writing 2 times and same error occured it shows up 2 times in sheet2 instead of 1 time

    Re: copy and remove duplicates


    Ok. It is my Guess. Since it is 'Filter' option, it automates the first value in list as Column Header. So, it ignores the Initial Value while removing duplicates. All other duplicates are removed correctly. May be, if you include a Dummy Column Header and include it in the range, it will work.


    Please check in MSDN for Advanced Filter Options, if it is still not helpful.

    Re: copy and remove duplicates


    This works with your example sheet. You need a header row for the data and use the CurrentRegion to define the data to copy.


    Code
    Sheets(1).Range("C5").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets(2).Range("F5"), Unique:=True

    Re: copy and remove duplicates


    found a smaller code


    Code
    Sheet2.Range("C5", Sheet2.Range("C5").End(xlDown)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheet2.Range("A1"), Unique:=True
        Sheet2.Range("A1", Sheet2.Range("A1").End(xlDown)).Cut
        Sheet1.Range("C7").Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
        Sheet1.Range("C7:C" & Range("C" & Rows.Count).End(xlUp).Row).RemoveDuplicates Columns:=1, Header:=xlNo

    If you like inefficient code then fine. Selecting is rarely necessary and inefficient in most cases.


    Your original code looks like the fastest option.

Participate now!

Don’t have an account yet? Register yourself now and be a part of our community!

Register Yourself Login