Excel – Get Unique List
June 11th, 2016 AdministratorExcel – Get Unique List – Method 1
|
1 2 3 4 5 6 7 8 9 10 11 12 |
Sub GetUniques() ' hiker95, 7 / 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 |
Excel – Get Unique List – Method 2
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 |
Sub UniqueList() 'http://www.freevbcode.com/ShowCode.asp?ID=4941 Dim rListPaste As Range Dim iReply As Integer On Error Resume Next Set rListPaste = Application.InputBox _ (Prompt:="Please select the destination cell", Type:=8) If rListPaste Is Nothing Then iReply = MsgBox("No range nominated," _ & " terminate", vbYesNo + vbQuestion) If iReply = vbYes Then Exit Sub End If 'May need to specify [NameofSheet].Range, e.g, Sheet1.Range Range("A2", Range("A100000").End(xlUp)).AdvancedFilter _ Action:=xlFilterCopy, CopyToRange:=rListPaste.Cells(1, 1), Unique:=True End Sub |
Excel – Get Unique List – Method 3
|
1 2 3 4 5 6 7 8 9 10 11 12 |
Sub CreateUniqueList() 'http://www.listendata.com/2013/05/excel-3-ways-to-extract-unique-values.html Dim lastrow As Long lastrow = Cells(Rows.Count, "A").End(xlUp).Row ActiveSheet.Range("A2:A" & lastrow).AdvancedFilter _ Action:=xlFilterCopy, _ CopyToRange:=ActiveSheet.Range("B2"), _ Unique:=True End Sub |