Creating a list/array in excel using VBA to get a list of unique names in a column

Question

I'm trying to create a list of unique names in a column but I've never understood how to use ReDim correctly, could someone help finish this off for me and explain how it's done or better suggest an alternative better/faster way.

Sub test()
    LastRow = Range("C65536").End(xlUp).Row
    For Each Cell In Range("C4:C" & LastRow)
        OldVar = NewVar
        NewVar = Cell
        If OldVar <> NewVar Then
            `x =...
        End If
    Next Cell
End Sub

My Data is in the format of:

Stack
Stack
Stack
Stack
Stack
Overflow
Overflow
Overflow
Overflow
Overflow
Overflow
Overflow
Overflow
.com
.com
.com

So essentially once it has the name once it will never popup again later on down in the list.

At the end the array should consist of:

    Stack
    Overflow
    .com

Solution 1

You can try my suggestion for a work around in Doug's approach.
But if you want to stick with your logic though, you can try this:

Option Explicit

Sub GetUnique()

Dim rng As Range
Dim myarray, myunique
Dim i As Integer

ReDim myunique(1)

With ThisWorkbook.Sheets("Sheet1")
    Set rng = .Range(.Range("A1"), .Range("A" & .Rows.Count).End(xlUp))
    myarray = Application.Transpose(rng)
    For i = LBound(myarray) To UBound(myarray)
        If IsError(Application.Match(myarray(i), myunique, 0)) Then
            myunique(UBound(myunique)) = myarray(i)
            ReDim Preserve myunique(UBound(myunique) + 1)
        End If
    Next
End With

For i = LBound(myunique) To UBound(myunique)
    Debug.Print myunique(i)
Next

End Sub

This uses array instead of range.
It also uses Match function instead of a nested For Loop.
I didn't have the time to check the time difference though.
So I leave the testing to you.

Solution 2

You don't need arrays for this. Try something like:

ActiveSheet.Range("$A$1:$A$" & LastRow).RemoveDuplicates Columns:=1, Header:=xlYes

If there's no header, change accordingly.

EDIT: Here's the traditional method, which takes advantage of the fact that each item in a Collection must have a unique key:

Sub test()
Dim ws As Excel.Worksheet
Dim LastRow As Long
Dim coll As Collection
Dim cell As Excel.Range
Dim arr() As String
Dim i As Long

Set ws = ActiveSheet
With ws
    LastRow = .Range("C" & .Rows.Count).End(xlUp).Row
    Set coll = New Collection
    For Each cell In .Range("C4:C" & LastRow)
        On Error Resume Next
        coll.Add cell.Value, CStr(cell.Value)
        On Error GoTo 0
    Next cell
    ReDim arr(1 To coll.Count)
    For i = LBound(arr) To UBound(arr)
        arr(i) = coll(i)
        'to show in Immediate Window
        Debug.Print arr(i)
    Next i
End With
End Sub

Solution 3

Inspired by VB.Net Generics List(Of Integer), I created my own module for that. Maybe you find it useful, too or you'd like to extend for additional methods e.g. to remove items again:

'Save module with name: ListOfInteger

Public Function ListLength(list() As Integer) As Integer
On Error Resume Next
ListLength = UBound(list) + 1
On Error GoTo 0
End Function

Public Sub ListAdd(list() As Integer, newValue As Integer)
ReDim Preserve list(ListLength(list))
list(UBound(list)) = newValue
End Sub

Public Function ListContains(list() As Integer, value As Integer) As Boolean
ListContains = False
Dim MyCounter As Integer
For MyCounter = 0 To ListLength(list) - 1
    If list(MyCounter) = value Then
        ListContains = True
        Exit For
    End If
Next
End Function

Public Sub DebugOutputList(list() As Integer)
Dim MyCounter As Integer
For MyCounter = 0 To ListLength(list) - 1
    Debug.Print list(MyCounter)
Next
End Sub

You might use it as follows in your code:

Public Sub IntegerListDemo_RowsOfAllSelectedCells()
Dim rows() As Integer

Set SelectedCellRange = Excel.Selection
For Each MyCell In SelectedCellRange
    If IsEmpty(MyCell.value) = False Then
        If ListOfInteger.ListContains(rows, MyCell.Row) = False Then
            ListAdd rows, MyCell.Row
        End If
    End If
Next
ListOfInteger.DebugOutputList rows

End Sub

If you need another list type, just copy the module, save it at e.g. ListOfLong and replace all types Integer by Long. That's it :-)

Solution 4

I realize this is an old question, but I use a much simpler way. Typically I just grab the list that I need, either by query or copying an existing list or whatever, then remove the duplicates. We will assume for this answer that your list is already in column C, row 4, as per the original question. This method works for whatever size list you have and you can select header yes or no.

Dim rng as range
Range("C4").Select
Set rng = Range(Selection, Selection.End(xlDown))
rng.RemoveDuplicates Columns:=1, Header:=xlYes

Solution 5

FWIW, here's the dictionary thing. After setting a reference to MS Scripting. You can jack around with the array size of avInput to match your needs.

Sub somemacro()
Dim avInput As Variant
Dim uvals As Dictionary
Dim i As Integer
Dim rop As Range

avInput = Sheets("data").UsedRange
Set uvals = New Dictionary


For i = 1 To UBound(avInput, 1)
    If uvals.Exists(avInput(i, 1)) = False Then
        uvals.Add avInput(i, 1), 1
    Else
        uvals.Item(avInput(i, 1)) = uvals.Item(avInput(i, 1)) + 1
    End If
Next i

ReDim avInput(1 To uvals.Count)
i = 1

For Each kv In uvals.Keys
    avInput(i) = kv
    i = i + 1
Next kv

Set rop = Sheets("sheet2").Range("a1")
rop.Resize(UBound(avInput, 1), 1) = Application.Transpose(avInput)




End Sub

View more solutions

Comments

[Ryflex]

I don't want to delete them in the sheet though, that's why I didn't use .RemoveDuplicates. I need them for a latter part of my code.

[L42]

@Ryflex you can copy it first somewhere and do Doug's approach. That is the fastest way that Iterating through each cell.

[Doug Glancy]

@L42, good idea. I did a post on this approach.

[L42]

plus one :D i was thingking of using a Dictionary but ended up using the array vs array comparison.

[Ryflex]

@L42 I decided to do your route, really simple approach.

[L42]

@Ryflex sure thing. Glad to be of help.