Gert-Jan
12/19/2006 9:48:00 PM
I found a good solution:
Sub FilterUniqueNumbers()
Dim rngYourrange As Range
Dim rngCell As Range
Dim colUniqueNumbers As New Collection
Dim i As Integer
Set rngYourrange = Worksheets("database").Range("B1:B30")
On Error Resume Next
For Each rngCell In rngYourrange
colUniqueNumbers.Add rngCell.Value, CStr(rngCell.Value)
Next rngCell
For i = 1 To colUniqueNumbers.Count
Worksheets("sheet1").Cells(i, 2).Value = colUniqueNumbers(i)
Next i
End Sub
"Gert-Jan" <info@cubique.nl> schreef in bericht
news:4588527e$0$8459$9ba1ec04@news.is.nl...
> Hi,
>
> This macro I use to create a list of unique values in a certain range.
> But, values that look like each other, are not shown in my list. For
> example: "red apple" and "apple" as values are seen as one, so apple will
> not be in the list. How should I change it, so that every unique value is
> in my list?
>
> Thanks, Gert-Jan
>
> Dim rngData As Range
> Dim strThisItem As String
> Dim strUnqItms As String
> Dim strTempAry() As String
> Dim itm As Variant
> For Each rngData In Worksheets("database").Range("B1:B100")
> If rngData = "" Then Exit For
> strThisItem = rngData
> If InStr(strUnqItms, strThisItem) = 0 Then
> strUnqItms = strUnqItms & "," & strThisItem
> End If
> Next rngData
> strTempAry = Split(strUnqItms, ",")
> Set rngData = Worksheets("sheets2").Range("J1")
> For Each itm In strTempAry
> If itm <> "" Then
> rngData = itm
> Set rngData = rngData.Offset(1, 0)
> End If
> Next itm
> End If
>