Unique List From Array

[JamesL]

Hi,

Is it possible to get a unique list of strings from an array without writing them to a worksheet first?

Example:

Names added to NameArray(6,0) = James, Bob, Jane, James, Nick, Bob

Run a procedue to go through NameArray and output a unique set of names to a worksheet. e.g James, Bob, Jane, Nick

Thanks in advance,
James

 

[erik.van.geit]

Hi, James,

two variations on the same theme

Option Explicit

Sub test1()
Dim arr As Variant
Dim dic As Object
Dim i As Integer

Set dic = CreateObject("Scripting.Dictionary")
arr = Array("James", "Bob", "Jane", "James", "Nick", "Bob")
    For i = 1 To UBound(arr)
    If Not dic.exists(arr(i)) Then dic.Add arr(i), Nothing
    Next

arr = dic.keys
Range("A1").Resize(UBound(arr) + 1, 1) = Application.Transpose(arr)


End Sub

Sub tes2()
Dim arr As Variant
Dim dic As Object
Dim i As Integer

Set dic = CreateObject("Scripting.Dictionary")
arr = Array("James", "Bob", "Jane", "James", "Nick", "Bob")
On Error Resume Next
    For i = 1 To UBound(arr)
    dic.Add arr(i), Nothing
    Next

arr = dic.keys
Range("A1").Resize(UBound(arr) + 1, 1) = Application.Transpose(arr)


End Sub

kind regards,
Erik

 

[JamesL]

Hi,

This code works fine. However i have added the names so that the code reads:

For RwS = 1 to 10
Array(rw, 0) sheet1.cells(RwS, 1)
rw=rw+1
Next RwS

where RwS was the number of rows containing strings. I try the following from the code below (in bold) and it debugs:

arr = Array(rw, 0)

How do make arr add all the strings for the code below to work?

Thanks in advance,
James


Code:
Option Explicit

Sub test1()
Dim arr As Variant
Dim dic As Object
Dim i As Integer

Set dic = CreateObject("Scripting.Dictionary")
arr = Array("James", "Bob", "Jane", "James", "Nick", "Bob")
For i = 1 To UBound(arr)
If Not dic.exists(arr(i)) Then dic.Add arr(i), Nothing
Next

arr = dic.keys
Range("A1").Resize(UBound(arr) + 1, 1) = Application.Transpose(arr)


End Sub

 

[erik.van.geit]

try this

Option Explicit

Sub test1()
Dim arr As Variant
Dim dic As Object
Dim i As Integer

Set dic = CreateObject("Scripting.Dictionary")
arr = sheet1.Range("A1:A10")
    For i = 1 To UBound(arr)
    If Not dic.exists(arr(i, 1)) Then dic.Add arr(i, 1), Nothing
    Next

arr = dic.keys
Range("A1").Resize(UBound(arr) + 1, 1) = Application.Transpose(arr)


End Sub