Create empty lists and then append elements to that list

Question

I have code in Python that I'm trying to convert to VBA.

List = [] 

For x in range:
    if x not in list:
    list.append(x)

I would create an empty list, the Python code would loop through my desired data (defined here as "range") then check if the element was in the list, and if it wasn't, add it.

I am trying to do the same in VBA. It needs to go down one column, and add unique elements in that column to a VBA list.

Based on searching I have this:

Dim list() As Variant

For n = 1 To end
   If list.Contains(Cells(n,1).value) Then 
       list(n) = Cells(n,1).value 
       n= n+1

When I run this code, I get an error where it highlights the "list" in

If list.Contains(Cells(n,1).value) Then

and says

"Invalid qualifier".

I tried changing it to

if list.Contains(Cells(n,1).value) = True

to add a qualifier.

All I need to do is create a list of strings. Is there a better way to do this in VBA?

when declared like `Dim list() As Variant`, `list` is an array not a collection or dictionary. You will want to use a Dictionary. But I would load the whole range in an array then iterate that into a collection to get the unique list. Or you can just copy the range to another sheet, use remove duplicates, then load the whole into the array and you will have an array of unique values. — Scott Craner, Dec 21 '18 at 22:51
If i understood your question you can read this post https://stackoverflow.com/questions/31690814/how-do-i-get-a-list-of-unique-values-from-a-range-in-excel-vba/31693059. Can help you to create lista with inique value — Ferdinando, Dec 21 '18 at 23:02

score 2 · Answer 1 · answered Dec 21 '18 at 22:59

This is probably a terrible answer, but since I don't use dictionaries, here is how I create an array of unique values - in this example, I'm adding all unique values in column A to an array (then printing them all at the end)

Option Explicit
Sub Test()

Dim list() As Variant
Dim inlist As Boolean
Dim n As Long, i As Long, j As Long, endrow As Long

endrow = Cells(Rows.Count, 1).End(xlUp).Row

ReDim list(0 To 0)
inlist = False
j = 0

For n = 1 To endrow
    For i = 0 To UBound(list)
        If list(i) = Cells(n, 1).Value Then
            inlist = True
        End If
    Next i

    If inlist = False Then
        list(j) = Cells(n, 1).Value
        j = j + 1
        ReDim Preserve list(0 To j)
    End If

    inlist = False
Next n

For i = 0 To UBound(list) - 1
    Debug.Print list(i)
Next i

End Sub

I really appreciate the comment dwirony, I went with another users answer but your comment actually really helped me out with another question I didn't even know I had till I read your comment. Thank you! — Jed Bartlet, Dec 28 '18 at 17:00

DisplayName · Answer 2 · 2018-12-26T15:21:39.800

1

Since you need an array of String objects, you could first build up a string out of unique values and then split it into an array:

For n = 1 To nEnd
    If InStr(1, strngs, "%" & Cells(n, 1).Value & "%") = 0 Then strngs = strngs & "%" & Cells(n, 1).Value & "%" & "|"
Next
If strngs <> vbNullString Then list = Split(Replace(Left(strngs, Len(strngs) - 1), "%", ""), "|")

edited Dec 26 '18 at 15:21

answered Dec 21 '18 at 23:57

DisplayName

13,283
2
11
19

The only issue with this solution is if one unique value is "Red Truck" and another is just "Truck", then the `InStr` criteria would be met for "Truck" and it wouldn't get entered as a value. – dwirony Dec 26 '18 at 15:09
@dwirony, good point, edited answer accordingly. Although Jed Bartlet doesn't seem to care any longer... – DisplayName Dec 26 '18 at 15:22
Maybe he figured it out on his own! :) – dwirony Dec 26 '18 at 15:24
1

or maybe he's simply not polite – DisplayName Dec 26 '18 at 15:26

score 1 · Answer 3 · answered Dec 22 '18 at 00:49

Spare a Column

If you have the data in column A and you can spare a column, e.g. column B, the fastest way to get the unique values in it should be using AdvancedFilter and then simply write (paste) the values to the array and do as you please with it.

ADV Version

Sub UniqueAF1()

  Const cVntSrcCol As Variant = "A"      ' Source List Column Letter/Number
  Const cVntUniCol As Variant = "B"      ' Unique List Column Letter/Number
  Const cIntHeaderRow As Integer = 1     ' Header Row Number

  Dim vntUni As Variant                  ' Unique Array
  Dim i As Long                          ' Unique Array Row Counter

  With ThisWorkbook.ActiveSheet

    ' Write unique values to Unique Column using AdvancedFilter.
    .Cells(cIntHeaderRow, cVntSrcCol).Resize(.Cells(.Rows.Count, cVntSrcCol) _
        .End(xlUp).Row - cIntHeaderRow + 1) _
        .AdvancedFilter 2, , .Cells(cIntHeaderRow, cVntUniCol), 2

    ' Write unique values to Unique Array
    vntUni = .Cells(cIntHeaderRow + 1, cVntUniCol) _
        .Resize(.Cells(.Rows.Count, cVntUniCol) _
        .End(xlUp).Row - cIntHeaderRow + 1)

    ' Print contents of Unique Array to Immediate window.
    For i = 1 To UBound(vntUni)
      Debug.Print vntUni(i, 1)
    Next

  End With

End Sub

EDU Version

Sub UniqueAF2()

  Const cVntSrcCol As Variant = "A"      ' Source List Column Letter/Number
  Const cVntUniCol As Variant = "B"      ' Unique List Column Letter/Number
  Const cIntHeaderRow As Integer = 1     ' Header Row Number

  Dim rngSrc As Range                    ' Source Range
  Dim rngUni As Range                    ' Unique Range

  Dim vntUni As Variant                  ' Unique Array

  Dim lngLastRow As Long                 ' Source Last Row
  Dim i As Long                          ' Unique Array Row Counter

  With ThisWorkbook.ActiveSheet

    Set rngSrc = .Cells(cIntHeaderRow, cVntSrcCol)  ' Source Range
    Set rngUni = .Cells(cIntHeaderRow, cVntUniCol)  ' Unique Range
    lngLastRow = .Cells(.Rows.Count, cVntSrcCol) _
        .End(xlUp).Row - cIntHeaderRow + 1          ' Calculate last row.
    Set rngSrc = rngSrc.Resize(lngLastRow)          ' Determine Source Range.

    ' Apply AdvancedFilter.
    rngSrc.AdvancedFilter 2, , .Cells(cIntHeaderRow, cVntUniCol), 2

    lngLastRow = .Cells(.Rows.Count, cVntUniCol) _
        .End(xlUp).Row - cIntHeaderRow + 1          ' Calculate last row.

    vntUni = rngUni.Resize(lngLastRow)              ' Paste range into array.

    ' Print contents of Unique Array to Immediate window.
    For i = 1 To UBound(vntUni)
      Debug.Print vntUni(i, 1)
    Next

  End With

End Sub

Vbasic, really appreciate your effort, unfortunately the situation is weird and I don't really have a spare column. My Vba also really sucks, so I'm still trying to figure out a lot of other things, but thanks for taking the time — Jed Bartlet, Dec 28 '18 at 17:01
Jed Bartlet: Have my solution on your mind, when you can spare a column because it's mighty fast. You have accepted the right answer. Good luck. — VBasic2008, Dec 28 '18 at 17:06

score 1 · Accepted Answer · answered Dec 22 '18 at 09:33

You can use a dictionary to process for unique items. In this case an array would be equivalent to a list. You populate the distinct list from the dictionary keys.

Public Sub test()
    Dim r As Range   ' this is what you would iterate over bit like your existing range
    Dim distinctList() 'empty list
    Dim dict As Object, inputValues(), i As Long
    Set r = ActiveSheet.Range("A1:A10")          'Alter as required
    Set dict = CreateObject("Scripting.Dictionary")
    inputValues = Application.Transpose(r.Value) 'List of all values. Faster to process as array.
    For i = LBound(inputValues) To UBound(inputValues)
        dict(inputValues(i)) = vbNullString 'add distinct list values to dictionary with overwrite syntax
    Next
    If dict.Count > 0 Then
        distinctList = dict.keys ' generate distinct list
    End If
End Sub

This worked really well! Thank you, I really really appreciate your comments in the code describing each thing. I'm still trying to understand the mechanics of it all, but it works and I'm going to mess around with a bit more. If I can ask a quick, question, if I wanted to do something similar but include duplicates, I could probably do something similar but not use dicts? — Jed Bartlet, Dec 28 '18 at 16:59

Create empty lists and then append elements to that list

4 Answers4

Spare a Column

ADV Version

EDU Version

Linked