New column of unique names VBA [duplicate] - excel

Question

This question already has an answer here:
Can we put dictionary items(array) into a Range with a single statement?
(1 answer)
Closed 6 months ago.
At the moment I have a range of names, and I need to create a new column which only contains the unique names.
Sub Unique_Values()
mySheet = Sheets("Sheet1").Range("E9:I20")
With CreateObject("scripting.dictionary")
For Each cell In mySheet
a = .Item(cell)
Next
Range("D2").Value = Join(.keys, vbLf)
End With
End Sub
This code creates a dictionary and returns the list of unique names, but it's one long list (i've just inserted it into D2) but I need it to populate column D with the unique names, one name per cell. I can't quite figure out how to loop through the keys and put them into an individual cell

Answer 1

Please, try the next updated code:
Sub Unique_Values()
Dim MySheet As Worksheet, rng As Range, cell As Range
Set MySheet = Sheets("Sheet1")
Set rng = MySheet.Range("E9:I20")
With CreateObject("scripting.dictionary")
For Each cell In rng.cells
.item(cell.Value) = 1
Next
MySheet.Range("D2").Resize(.count, 1).Value2 = Application.Transpose(.Keys)
End With
End Sub
It is good to declare all necessary variable, naming them in a relevant way.
Then, dict.keys is a 1D array (not having rows) and to place it in a column, it needs to be transposed.
I only tried adapting your code as it is. To make it faster, the iterated range should be placed in an array and then all the array processing will be done in memory, resulting a faster result. Anyhow, for the range you show us (if this is the real one), processing should take less than a second...
In fact, the faster version is easy to be designed, so here it is:
Sub Unique_Values_Array()
Dim MySheet As Worksheet, arr, i As Long, j As Long
Set MySheet = Sheets("Sheet1")
arr = MySheet.Range("E9:I20").Value2
With CreateObject("scripting.dictionary")
For i = 1 To UBound(arr)
For j = 1 To UBound(arr, 2)
.item(arr(i, j)) = 1
Next j
Next i
MySheet.Range("D2").Resize(.count, 1).Value2 = Application.Transpose(.Keys)
End With
End Sub
It makes sense and speed difference only in case of larger ranges...

Answer 2

If you use a collection you can create a unique list and write to the range. A collection will not let you add the same index key twice, therefore we ignore the error and then resume error checking when done writing.
Sub test()
Dim myNames As New Collection
Dim mySheet As Range
Dim i As Long
Set mySheet = Sheets("Sheet1").Range("E9:I20")
On Error Resume Next
For Each cell In mySheet
myNames.Add cell, cell.Value
Next
On Error GoTo 0
For i = 1 To myNames.Count
Worksheets("Sheet1").Cells(i + 2, 4) = myNames(i)
Next
End Sub