Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

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

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
like image 492
Ryflex Avatar asked Dec 09 '22 09:12

Ryflex


2 Answers

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.

like image 110
L42 Avatar answered May 06 '23 02:05

L42


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
like image 20
Doug Glancy Avatar answered May 06 '23 01:05

Doug Glancy