Comments on: Create Unique List from Selected Cells

By: Pete

Pete — Wed, 21 Jul 2010 06:04:00 +0000

Sorry about the code tags. Should be

Sub UniqueItems()

On Error GoTo ErrorHandler
With Selection
.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Cells(1, Cells.Find(what:="*", After:=Cells(1, 1), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 2), Unique:=True
End With

ResumeHere:
Exit Sub

ErrorHandler:
MsgBox Prompt:="Something went wrong !!", Buttons:=vbCritical, Title:="Error ..."
GoTo ResumeHere
End Sub

By: Pete

Pete — Wed, 21 Jul 2010 06:03:00 +0000

Code from my personal.xls file is below. Uses Excel's advanced filter, so there must be a header, and pastes result to the right hand side, one column clear. One plus I like with advanced filter is handling mutliple columns to return all distinct possibilities.

[code]Sub UniqueItems()

On Error GoTo ErrorHandler
With Selection
.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Cells(1, Cells.Find(what:="*", After:=Cells(1, 1), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 2), Unique:=True
End With

ResumeHere:
Exit Sub

ErrorHandler:
MsgBox Prompt:="Something went wrong !!", Buttons:=vbCritical, Title:="Error ..."
GoTo ResumeHere
End Sub[/code]

By: Carlos Rondão

Carlos Rondão — Tue, 05 Jan 2010 14:23:00 +0000

This is very easy without any programming:

Values in A1:A30

In B1 put value 1
In B2 put the formula:
=IF(ISERROR(MATCH(A2;$A$1:A1;0));MAX(B$1:B1)+1;"")
copy formula down till B30

In C1 put the value 1
In C2 the formula =C1+1

In D1 the formula:
=INDEX(A$1:A$30;MATCH(C1;$B$1:$B$30;0))

copy to D2

Now copy C2:D2 down...

In column D you have the A1:A30 unique values

By: Filtering Unique Cell Values in Excel « One Stop Analytics

Filtering Unique Cell Values in Excel « One Stop Analytics — Tue, 02 Jun 2009 13:02:00 +0000

[...] terms of speed goes. Refer to this page for a readymade piece of code, that runs like a darling! (http://www.dailydoseofexcel.com/archives/2008/12/11/create-unique-list-from-selected-cells/). Again, I’m not very versatile with Collections, so I can’t explain much. But [...]

By: Hans Schraven

Hans Schraven — Mon, 05 Jan 2009 22:24:00 +0000

If you go for speed:

Sub tst1()
Dim t As Long, i As Long, c0 As String

t = Timer
Columns(1).SpecialCells(xlCellTypeConstants).AdvancedFilter xlFilterCopy, , [K1], True
Debug.Print Timer - t
End Sub

I tested this one to 3 alternatives with a list of 8000 textstrings.
Speed performance tst1:tst2:tst3:tst4 = 1:23:55:112

Sub tst2()
Dim t As Long, i As Long, c0 As String

t = Timer
Set colUnique = New Collection
On Error Resume Next
For Each cl In Columns(1).SpecialCells(xlCellTypeConstants)
colUnique.Add cl, Format(cl)
Next
On Error GoTo 0

i = 0
For Each it In colUnique
Range("G1").Offset(i, 0).Value = it
i = i + 1
Next
Debug.Print Timer - t
End Sub

Sub tst3()
Dim t As Long, i As Long, c0 As String
t = Timer
sq = Application.WorksheetFunction.Transpose(Columns(1).SpecialCells(xlCellTypeConstants))
For i = 1 To UBound(sq)
If InStr("#" & c0, "#" & sq(i) & "|") = 0 Then c0 = c0 & sq(i) & "|#"
Next
sq = Split(c0, "|#")
Cells(1, 4).Resize(UBound(sq) + 1) = WorksheetFunction.Transpose(sq)
Debug.Print Timer - t
End Sub

Sub tst4()
Dim t As Long, i As Long, c0 As String

t = Timer
sq = Split("|" & Join(Application.WorksheetFunction.Transpose(Columns(1).SpecialCells(xlCellTypeConstants)), "|#|") & "|", "#")
For i = 0 To UBound(sq)
If UBound(Filter(sq, sq(i))) > 0 Then sq(i) = "#"
Next
sq = Split(Replace(Join(Filter(sq, "#", False), "#"), "|", ""), "#")
Cells(1, 4).Resize(UBound(sq) + 1) = WorksheetFunction.Transpose(sq)
Debug.Print Timer - t
End Sub

By: Charlie Hall

Charlie Hall — Mon, 05 Jan 2009 19:34:00 +0000

@Hans:

Looks slick

By: David Braithwaite

David Braithwaite — Mon, 05 Jan 2009 04:38:00 +0000

Hans
nice solution for moderate amount of data getting appended to string. But if large amount; each one causes the recopying of a bigger and bigger string and consume cobs of time as the string grows. A more general solution might allocate a large string and then lay data into with a Mid(bigstring,x,y)= approach, appending more space only when the allocated space was used...

By: Hans Schraven

Hans Schraven — Sat, 03 Jan 2009 00:19:00 +0000

@Charlie

A simpler solution:

Sub enkel()
Dim sq As Variant
Dim j As Long

If Selection.Columns.Count = 1 Then
sq = Application.WorksheetFunction.Transpose(Selection.SpecialCells(xlCellTypeConstants))
For j = 1 To UBound(sq)
If InStr(c0 amp; "|", "|" amp; sq(j) amp; "|") = 0 Then c0 = c0 amp; "|" amp; sq(j)
Next
Sheets(1).[K1].Resize(UBound(Split(c0, "|"))) = Application.WorksheetFunction.Transpose(Split(Mid(c0, 2), "|"))
End If
End Sub

PS. A String can contain more then 2 million characters. So don't worry.

By: Charlie Hall

Charlie Hall — Fri, 02 Jan 2009 19:28:00 +0000

@Hans
I tried to implement your solution but was unable to get it to work. I think there are three issues. Your replacement string is "" so the two elements on either side get concatenated. You start with a 1-based array and move to a 0-based array so the 2nd element gets skipped. And the For termination value I believe is only evaluated at the beginning, but if there are many repeats, the array can shrink quickly, so near the end it will be evaluating non-existant array elements.

I also wonder about how large a string can be - and as such, will this only work with small lists?

By: Hans Schraven

Hans Schraven — Wed, 17 Dec 2008 12:24:00 +0000

@Jim

You are quite right. To solve this:

Sub enkel()
Dim sq As Variant
Dim j As Long

If Selection.Columns.Count = 1 Then
sq = Application.WorksheetFunction.Transpose(Selection.SpecialCells(xlCellTypeConstants))
For j = 1 To UBound(sq)
sq=split(replace("|" & join(sq,"|") & "|","|" & sq(j) & "|","") & "|" & sq(j),"|")
Next
Sheets(1).[K1].Resize(UBound(sq) + 1) = Application.WorksheetFunction.Transpose(sq)
End If
End Sub