Unique List From Array

JamesL

Board Regular
Joined
Apr 21, 2004
Messages
113
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
 

Some videos you may like

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).

erik.van.geit

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832
Hi, James,

two variations on the same theme
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

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

Board Regular
Joined
Apr 21, 2004
Messages
113
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

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832
try this
Code:
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
 

Watch MrExcel Video

Forum statistics

Threads
1,113,849
Messages
5,544,647
Members
410,627
Latest member
georgealice
Top