# Unique List From Array

#### JamesL

##### Board Regular
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

James

### Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
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)
Next

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

End Sub``````
kind regards,
Erik

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?

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

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``````

Replies
6
Views
294
Replies
33
Views
977
Replies
9
Views
348
Replies
0
Views
254
Replies
6
Views
226

1,219,808
Messages
6,150,351
Members
450,952
Latest member
Zung

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back