select unique values range to column

[rhvanloenen]

Sub SelectUniqueValues()

'I want to select the unique values from range("A4:F70")
'and show them from K4, sorted aswell.
'the script works fine, but only for the first column, not for the wanted range,
'I tries several changes, but they don't work.
'What does I have to change?

Dim X
Dim objDict As Object
Dim lngRow As Long

Set objDict = CreateObject("Scripting.Dictionary")
X = Application.Transpose(Range([a1], Cells(Rows.Count, "A").End(xlUp)))

For lngRow = 1 To UBound(X, 1)
    objDict(X(lngRow)) = 1
Next
Range("K4:K" & objDict.Count) = Application.Transpose(objDict.keys)
End Sub

[alansidman]

Code Tags Added
Your post does not comply with Rule 3 of our Forum RULES. Use code tags around code.

Posting code between [CODE] [/CODE] tags makes your code much easier to read and copy for testing, it also maintains VBA formatting.

Highlight your code and click the # icon at the top of your post window. More information about these and other tags can be found at http://www.excelforum.com/forum-rule...rum-rules.html



(Because you are new to the forum, I have added them for you today. Please take a few minutes to read all Forum Rules and comply in the future.)

[bakerman2]

Sub SelectUniqueValues()
    Dim sn, lngRow As Long, lngCol As Long
    sn = Range("A4:F40")
    With CreateObject("Scripting.Dictionary")
        For lngRow = 1 To UBound(sn, 1)
            For lngCol = 1 To UBound(sn, 2)
                If sn(lngRow, lngCol) <> "" Then x0 = .Item(sn(lngRow, lngCol))
            Next
        Next
        Range("K4:K" & .Count + 3) = Application.Transpose(.keys)
    End With
End Sub

[jindon]

Sub test()
    Dim e, x As Object
    With CreateObject("System.Collections.ArrayList")
        Set x = .Clone
        For Each e In Intersect(Columns("a:f"), ActiveSheet.UsedRange).Value
            If e <> "" Then
                If IsNumeric(e) Then
                    If Not .Contains(e) Then .Add e
                Else
                    If Not x.Contains(e) Then x.Add e
                End If
            End If
        Next
        .Sort: x.Sort
        .AddRange x
        [k4].Resize(.Count).Value = Application.Transpose(.ToArray)
    End With
End Sub

[rhvanloenen]

Tnx. Ik works as I wanted.

[jindon]

You are welcome and thanks for the rep.

If that takes care of your original question, please select Thread Tools from the menu link above and mark this thread as SOLVED.