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
This question is related to
vba
excel
excel-2007
excel-2010
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
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 :-)
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
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
Source: Stackoverflow.com