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
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.
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
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With