New column of unique names VBA

Question

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

Range("D2:D" & CStr(2+.Count)).Value =.Keys or something similar — freeflow, Aug 16 '22 at 13:19
Are you sure you need vba? If not, then have a look [here](https://stackoverflow.com/q/62204826/9758194). Multiple answers with great idea how to resolve this without having to resort to VBA. — JvdV, Aug 16 '22 at 13:35
Yes I need vba, it's part of a bigger macro for updating a table — LibbyB, Aug 16 '22 at 13:39

FaneDuru · Answer 1 · 2022-08-16T13:33:58.813

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

score -2 · Accepted Answer · answered Aug 16 '22 at 13:21

-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

answered Aug 16 '22 at 13:21

Darrell H

1,876
1
9
14

Didn't downvote your answer, but a Dictionary does let you overwrite Key-values on the go (no error handling needed) plus you can write the entire dictionary to the worksheet in a single array-handling statement. OP accepted your answer, but just know that using a collection would be inferior in this specific case. – JvdV Aug 16 '22 at 13:40
@LibbyB you've accepted the inferior answer. Your `Dictionary` approach was better. The other posted answer will *definitely* be faster than this. – BigBen Aug 16 '22 at 13:41
@JvdV Good to know. I was just offering up what has worked for me in this situation. – Darrell H Aug 16 '22 at 14:35

New column of unique names VBA

2 Answers2