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

 

[jdsouza]

Try this ..

Public Sub ABC()Dim StartRow As Long, EndRow As Long, J As Integer, K As Long, L As Integer
Dim fGroup As Boolean
'Assuming your data is in Sheets(1) and 'All Codes' is in column 'C'
Application.ScreenUpdating = False
StartRow = 2
Sheets(1).Select
Sheets(3).Columns("A:IV").Clear
Sheets(2).Columns("A:IV").Clear
Sheets(1).Cells(1, 3).Select
Sheets(1).Cells(ActiveSheet.Rows.Count, 3).Select
EndRow = Selection.End(xlUp).Row
Sheets(1).Cells(1, 3).Select
Sheets(1).Range(Range(Cells(StartRow, 3), Cells(EndRow, 3)).Address).Copy
Sheets(1).Cells(1, 4).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Sheets(1).Range(Range(Cells(StartRow, 4), Cells(EndRow, 4)).Address).RemoveDuplicates Columns:=1, Header:=xlYes
Sheets(1).Cells(1, 4).Select
Sheets(1).Cells(ActiveSheet.Rows.Count, 4).Select
EndRow = Selection.End(xlUp).Row
Sheets(1).Range(Range(Cells(StartRow, 4), Cells(EndRow, 4)).Address).Copy


MsgBox "Done." & vbNewLine & "Unique records copied to clipboard"


End Sub

 

[Gary McMaster]

Another option:

Public Sub Test()

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

End Sub

 

[hiker95]

boldcode,


Sample raw data:

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

After the macro:

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

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, by highlighting the code and pressing the keys CTRL + C
2. Open your 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 by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Option Explicit
Sub GetUniques()
' hiker95, 07/26/2012
' http://www.mrexcel.com/forum/showthread.php?649576-Extract-unique-values-from-one-column-using-VBA
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)
  d(c(i, 1)) = 1
Next i
Range("B2").Resize(d.Count) = Application.Transpose(d.keys)
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


Then run the GetUniques macro.

 

[lostitagain]

Sub FindDistinctValues()
Dim LastRowFrom As Long
Dim LastRowTo As Long
Dim i As Long, j As Long
Dim temp As Integer
Dim found As Boolean
'determines the last row that contains data in column A
LastRowFrom = Range("A" & Rows.Count).End(xlUp).Row
'Loop for each entry in column A
For i = 2 To LastRowFrom
   'get the next value from column A
   temp = Range("A" & i).Value
   
   'Determine the last row with data in column B
   LastRowTo = Range("B" & Rows.Count).End(xlUp).Row
   
   'initialize j and found
   j = 1
   found = False
   
   'Loop through "To List" until a match is found or the list has been searched
   Do
      'check if the value exists in B column
      If temp = Range("B" & j).Value Then
         found = True
      End If
      'increment j
      j = j + 1
      Loop Until found Or j = LastRowTo + 1
   
   'if the value is not already in column B
   If Not found Then
      Range("B" & j).Value = temp
   End If
Next i
End Sub

 

[boldcode]

Gary, lostitagain, hiker95, jdsouza,

I gave all 4 recommendations a try and they all produce the result I was looking for. Thank you all for your responses, I appreciate it.

BC

 

[hiker95]

boldcode,

Thanks for the feedback.

You are very welcome. Glad we could help.

Come back anytime.

 

[blthlt]

How do I do this to loop through either all or specific sheets in a workbook and not have it overwrite the output on each loop?

boldcode,


Sample raw data:


Sheet1

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

<tbody>
</tbody>

Excel tables to the web >> Excel Jeanie HTML 4




After the macro:


Sheet1

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

<tbody>
</tbody>

Excel tables to the web >> Excel Jeanie HTML 4




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, by highlighting the code and pressing the keys CTRL + C
2. Open your 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 by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Option Explicit
Sub GetUniques()
' hiker95, 07/26/2012
' http://www.mrexcel.com/forum/showthread.php?649576-Extract-unique-values-from-one-column-using-VBA
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)
  d(c(i, 1)) = 1
Next i
Range("B2").Resize(d.Count) = Application.Transpose(d.keys)
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


Then run the GetUniques macro.

 

[hiker95]

blthlt,

How do I do this to loop through either all or specific sheets in a workbook and not have it overwrite the output on each loop?

I am going to guess that your raw data structure is not the same as boldcode's.

Please do not post your questions in threads started by others - - this is known as thread hijacking.

Always start a new thread for your questions and, if you think it helps, provide a link to any other thread as a reference.

Start a new thread for your question and be sure to give it a search friendly title that accurately describes your need.


In your NEW thread also include:

What version of Excel and Windows are you using?

Can you post a screenshot of the actual raw data worksheet?

And, can you post a screenshot of the worksheet results (manually formatted by you) that you are looking for?

To post your data, you can download and install one of the following two programs:
Excel Jeanie
MrExcel HTML Maker

Or, when using Internet Explorer, just put borders around your data in Excel and copy those cells into your post.
See reply #2 the BLUE text in the following link:
http://www.mrexcel.com/forum/about-board/444901-how-create-table-like-aladin.html#post2198045


If you are not able to give us screenshots:
You can upload your workbook to Box Net,
sensitive data changed
mark the workbook for sharing
and provide us with a link to your workbook.


Then send me a Private Message, with a link to your NEW thread, and, I will have a look.


If you are not able to do the above, then:

Click on the Reply to Thread button, and just put the word BUMP in the thread. Then, click on the Post Quick Reply button, and someone else will assist you.

 

[blthlt]

blthlt,



I am going to guess that your raw data structure is not the same as boldcode's.

Please do not post your questions in threads started by others - - this is known as thread hijacking.

Always start a new thread for your questions and, if you think it helps, provide a link to any other thread as a reference.

Start a new thread for your question and be sure to give it a search friendly title that accurately describes your need.


In your NEW thread also include:

What version of Excel and Windows are you using?

Can you post a screenshot of the actual raw data worksheet?

And, can you post a screenshot of the worksheet results (manually formatted by you) that you are looking for?

To post your data, you can download and install one of the following two programs:
Excel Jeanie
MrExcel HTML Maker

Or, when using Internet Explorer, just put borders around your data in Excel and copy those cells into your post.
See reply #2 the BLUE text in the following link:
http://www.mrexcel.com/forum/about-board/444901-how-create-table-like-aladin.html#post2198045


If you are not able to give us screenshots:
You can upload your workbook to Box Net,
sensitive data changed
mark the workbook for sharing
and provide us with a link to your workbook.


Then send me a Private Message, with a link to your NEW thread, and, I will have a look.


If you are not able to do the above, then:

Click on the Reply to Thread button, and just put the word BUMP in the thread. Then, click on the Post Quick Reply button, and someone else will assist you.

Actually, I thought since the OP's question WAS ANSWERED, me asking my question shouldn't have been a thread jack, rather I'm asking how to do the same VBA code just looped through multiple sheets. I've always been around forums where people would help people instead of "over moderate". I see no harm in ADDING TO the information in this thread seeing how I can make the changes to the existing code work with my raw data. I honestly feel with the time you took to write your "go start your own thread" post you could have answered my question which was, how do I loop THIS CODE through all sheets in a workbook. I don't think I'm asking for too much considering I thought most forums didn't like duplicate post. Ill hold off on doing your recommendation as I would rather wait for someone to just answer my question; how do I loop the code in my first post quote through all pages of a book.