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   amp  LastRow          OldVar   NewVar         NewVar   Cell         If OldVar  lt  gt  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

User · Answer

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  -

User · Answer

You don t need arrays for this  Try something like   ActiveSheet Range   A 1  A    amp  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   amp   Rows Count  End xlUp  Row     Set coll   New Collection     For Each cell In  Range  C4 C   amp  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

User · Answer

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

User · Answer

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

User · Answer

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

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

Examples related to vba

Examples related to excel

Examples related to excel-2007

Examples related to excel-2010