Create list of unique values/strings from one sheet to another

I have 40K rows in sheet1 column C but only ~75 unique values/strings in that column.

I need the unique list to be copied to Sheet2 row 1.

I would prefer not to copy all/sort by unique, rather copy only unique values, ie. look in sheet1 column C, get unique values and copy to sheet2, starting at column A row 2.

Has to be VBA (macro).

Thanks in Advance,

swjtx99
swjtx99Asked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

aikimarkCommented:
you can use the advancedfilter to do this.  Click the Unique Values checkbox.
0
ProfessorJimJamMicrosoft Excel ExpertCommented:
Do you want vba or dynamic formula?
0
swjtx99Author Commented:
It needs to be VBA. I can do this already with advancedfilter/unique values and with a dynamic formula but I am trying to automate the process.

Attached is an example File. Sheet1 is an example data set and sheet2 is what I wantExample2.xlsx the VBA to create.
0
Exploring SharePoint 2016

Explore SharePoint 2016, the web-based, collaborative platform that integrates with Microsoft Office to provide intranets, secure document management, and collaboration so you can develop your online and offline capabilities.

aikimarkCommented:
Here are the recorded commands packaged into a single user-defined function.
Sub Q_28535711()
    Dim wksSrc As Worksheet
    Dim wksTgt As Worksheet
    Dim rngSrc As Range
    Dim rngTgt As Range
    Dim lngRows As Long
    Set wksSrc = Sheets("Sheet1")
    Set wksTgt = Sheets("Sheet2")
    'copy unique values to sheet2
    wksSrc.Range(wksSrc.Range("A1"), wksSrc.Range("A1").End(xlDown)).AdvancedFilter _
                Action:=xlFilterCopy, CopyToRange:=wksTgt.Range("A1"), Unique:=True
    
    'transpose the data
    Set rngSrc = wksTgt.Range(wksTgt.Range("A2"), wksTgt.Range("A2").End(xlDown))
    lngRows = rngSrc.Rows.Count
    Set rngTgt = wksTgt.Range(wksTgt.Cells(1, 1), wksTgt.Cells(1, lngRows))
    rngTgt.Value = WorksheetFunction.Transpose(rngSrc)
    
    'clear the original unique data values
    rngSrc.ClearContents
End Sub

Open in new window

0
ProfessorJimJamMicrosoft Excel ExpertCommented:
Hello,

here is the fast and short code.

Sub Extractunique()
    Dim a, e
    With Sheets("Sheet1")
        a = .Range("C1", .Range("C" & Rows.Count).End(xlUp)).Value
    End With
    With CreateObject("Scripting.Dictionary")
        .CompareMOde = 1
        For Each e In a
            If Not IsEmpty(e) Then .Item(e) = Empty
        Next
        Sheets("sheet2").Range("A2", Columns("A").SpecialCells(xlCellTypeLastCell)).ClearContents
        Sheets("sheet2").Range("A2").Resize(.Count).Value = Application.Transpose(.keys)
    End With
End Sub

Open in new window

0
aikimarkCommented:
@ProfessorJimJam

With a dictionary object, you should use its .EXISTS() method.
0
ProfessorJimJamMicrosoft Excel ExpertCommented:
Thanks Aikimark,  for pointing it.  yes, i should have used .exists in stead of isempty

here is the revised code

Sub Extractunique()
    Dim a, e
    With Sheets("Sheet1")
        a = .Range("C1", .Range("C" & Rows.Count).End(xlUp)).Value
    End With
    With CreateObject("Scripting.Dictionary")
        .CompareMOde = 1
        For Each e In a
            If Not .exists(e) Then .Item(e) = Empty
        Next
        Sheets("sheet2").Range("A2", Columns("A").SpecialCells(xlCellTypeLastCell)).ClearContents
        Sheets("sheet2").Range("A2").Resize(.Count).Value = Application.Transpose(.keys)
    End With
End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
swjtx99Author Commented:
Hi,

Thanks to you both. ProfessorJimJam's worked better, however the transpose at the end doesn't seem to work.

Regards,

swjtx99
0
aikimarkCommented:
@swjtx99
doesn't seem to work
Which transpose doesn't work?

You should work with the experts until you have a working solution.  Should we reopen the question for further dialog?
0
ProfessorJimJamMicrosoft Excel ExpertCommented:
@swjtx99

what do you mean the transpose does not work?

check your original question.  your question do not state to transpose the the list.

if you are referring to line 12 of the code Application.Transpose(.keys)

this is not the Transpose you use in built excel function.  This Transpose has a different functionality.

try to to remove it and instead just put Sheets("sheet2").Range("A2").Resize(.Count).Value = .keys

then see you get a wrong result and this is the power of Application.Transpose(.keys)  that make the code do what you asked for.


if you are interested to learn how to use Dictionary-Class-in-VBA  then in Experts Exchange forum, there is a very good article written by Patrick Matthews

check it here
http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/A_3391-Using-the-Dictionary-Class-in-VBA.html

i believe what you got what you asked for , in this thread. if you have any other question. you may need to open a new question.

regards,

Professor
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.