Extract unique values from one column using VBA

[boldcode]

Hi,

I want to extract all the unique values from column A starting with A2 to the last cell of column A that has a value and copy those values into cell B2 all the way down to whatever the last cell of column B is.

I have row titles in cells A1 and B1.

Example:

Data Before Macro:

	Column A	Column B
Row 1	All Codes	Distinct Codes
Row 2	456
Row 3	456
Row 4	678
Row 5	678
Row 6	890
Row 7	543
Row 8	543
Row 9	234
Row 10	213
Row 11	905
Row 12	905

<colgroup><col style="mso-width-source:userset;mso-width-alt:4096;width:84pt" width="112"> <col style="mso-width-source:userset;mso-width-alt:5997;width:123pt" width="164"> <col style="mso-width-source:userset;mso-width-alt:4973;width:102pt" width="136"> </colgroup><tbody>
</tbody>

Data After Macro:

	Column A	Column B
Row 1	All Codes	Distinct Codes
Row 2	456	456
Row 3	456	678
Row 4	678	890
Row 5	678	543
Row 6	890	234
Row 7	543	213
Row 8	543	905
Row 9	234
Row 10	213
Row 11	905
Row 12	905

<colgroup><col style="mso-width-source:userset;mso-width-alt:4864;width:100pt" width="133"> <col style="mso-width-source:userset;mso-width-alt:4571;width:94pt" width="125"> <col style="mso-width-source:userset;mso-width-alt:5120;width:105pt" width="140"> </colgroup><tbody>
</tbody>

Thanks,

BC

 

[BillsMafia]

SerhatC,

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Sub ExtractUniquesMulti()
' hiker95, 12/15/2015, ME749576
Dim d As Object, o As Variant, i As Long
Dim lr As Long, lc As Long, c As Long
Application.ScreenUpdating = False

With Sheets("Sheet1")   '<-- you can change the sheet name here

  lc = .Cells(2, Columns.Count).End(xlToLeft).Column
  For c = 1 To lc - 1 Step 3
    Set d = CreateObject("Scripting.Dictionary")
    lr = .Cells(Rows.Count, 1).End(xlUp).Row
    o = .Range(.Cells(3, c), .Cells(lr, c))
    For i = 1 To UBound(o, 1)
      d(o(i, 1)) = 1
    Next i
    .Cells(3, c + 1).Resize(d.Count) = Application.Transpose(d.keys)
    Set d = Nothing
    Erase o
  Next c
End With
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm, and, answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

Then run the ExtractUniquesMulti macro.

Hello Hiker (or anyone else who can answer this question) - I saw this piece of code and realized it would be highly useful to me in the projects I'm working on so that I am getting my unique list in memory instead of having to do range().removeduplicates and manipulate my worksheet. That being said, I like to understand what the code I plan to use means and how it works before I use it. I did quite a bit of reading on Dictionaries and there is 1 part of this code that I'm not fully sure I understand:

1 - Why you have to use 'Application.Transpose' when writing it to the sheet?


Thank you for posting this code as it has resulted in my VBA knowledge expanding quite a bit. Dictionaries seem quite powerful.

 

[hiker95]

Why you have to use 'Application.Transpose' when writing it to the sheet?

BillsMafia,

Welcome to the MrExcel forum.

Sample short version of the raw data, for Report1:

Excel 2007
	A	B
1	Report1
2	Full	Unique
3	7
4	1
5	5
6	1
7	2
8	1
9	5
10	1
11	3
12	2
13	9
14	1
15	5
16	9
17
18
Sheet1

If I run the original macro, we get this:

Excel 2007
	A	B
1	Report1
2	Full	Unique
3	7	7
4	1	1
5	5	5
6	1	2
7	2	3
8	1	9
9	5
10	1
11	3
12	2
13	9
14	1
15	5
16	9
17
18
Sheet1

If I change one line of macro code, from this:

    .Cells(3, c + 1).Resize(d.Count) = Application.Transpose(d.Keys)

To this:

    .Cells(3, c + 1).Resize(d.Count) = d.Keys

And, run the modified macro, we get this (the first Key duplicated six times):

Excel 2007
	A	B
1	Report1
2	Full	Unique
3	7	7
4	1	7
5	5	7
6	1	7
7	2	7
8	1	7
9	5
10	1
11	3
12	2
13	9
14	1
15	5
16	9
17
18
Sheet1

I hope the above helps you to better understand the original macro code.

 

[chrisignm]

Try this slight modification on hiker95's nifty code:

Option Explicit
Sub GetUniques()
' hiker95, 07/26/2012
' Extract unique values from one column using VBA  Trebor76, 02/08/2016 now excluding blanks
Dim d As Object, c As Variant, i As Long, lr As Long
Set d = CreateObject("Scripting.Dictionary")
lr = Cells(Rows.Count, 1).End(xlUp).Row
c = Range("A2:A" & lr)
For i = 1 To UBound(c, 1)
    If Len(c(i, 1)) > 0 Then
        d(c(i, 1)) = 1
    End If
Next i
'Adds a New Sheet
Worksheets.Add
ActiveSheet.Name = "UNIQUE VALUES"
Range("a1").Activate
Range("a1").Resize(d.Count) = Application.Transpose(d.keys)
End Sub

Thank you! Best Excel forum ever Was looking for this for over an hour. A lot faster than using the array formulas that you usually find with Google.

 

[hiker95]

chrisignm,

Thanks for the feedback.

You are very welcome. Glad I could help.

And, come back anytime.

 

[JEMCO]

I have used this and it works fine with more than 1 record but fails when only one value on the line For i = 1 To UBound(c, 1)
how can this be modified for just one value please.

 

[hiker95]

I have used this and it works fine with more than 1 record but fails when only one value on the line For i = 1 To UBound(c, 1)
how can this be modified for just one value please.

JEMCO,

Welcome to the MrExcel forum.


We would like more information. Please see the Forum Use Guidelines in the following link:

http://www.mrexcel.com/forum/board-announcements/127080-guidelines-forum-use.html


See reply #2 at the next link, if you want to show small screenshots, of the raw data, and, what the results should look like.

http://www.mrexcel.com/forum/about-board/508133-attachments.html#post2507729


Or, you can post your workbook/worksheets to the following free site (sensitive data changed), mark the workbook for sharing, and, provide us with a link to your workbook:

 

[jddent9822]

Hi Gary,
I tried using the AdvancedFilter statement shown above. It seemed pretty simple. But every time it does the CopyToRange portion it outputs the first unique data twice! Any thoughts?

 

[Gary McMaster]

Have a look here:

http://www.mrexcel.com/forum/excel-...using-advanced-filter-unique-values-only.html

 

[leesjason]

Another option:

Public Sub Test()

ActiveSheet.Range("A2:A65536").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ActiveSheet.Range("B2"), Unique:=True

End Sub

Hello,
The code above renders unique text values for a list of either numbers or text.
How would you modify the code (above) to convert the rendered text to number values?
Thank you!

 

[Englishboxer]

Hi,

Just used this and it is amazing!

I try to understand code i use so as not to get too confused by it, i get that you are essentially storing the values in a dictionary and deduping (i think)?

Is there a way to get this to check two columns and produce the unique list? i.e. list of names and list of months then return unique list of names and months.

ex:

Jon September
Jon January

Phillip December

I have tried to fiddle with it myself but the skills are beyond what i'm capable of at the moment