VBA to create list of unique values matching a condition, drawn from a large dataset

[Frysk]

Hi all, and thanks for looking.

I have a dataset of 500,000+ rows.

Column A = unique identifier (alphanumeric), with many duplicates. For example, "Abby1" might have 1,000 rows before we see "Adam1".
Column B = helper column, filled down, where a "1" indicates if this row is relevant. Otherwise it is a "0".

Maybe relevant: "Abby1" rows will always be together. Once they end and "Adam1" rows begin, "Adam1" rows are together, until the next unique identifier, and so on.

Goal: to create a list of unique values (from column A), where those values each have at least one instance of "1" in their rows. Example, if Abby has 1,000 rows, and at least one row has a "1" in helper column B, then Abby is included in this unique list.

I have tried a few functions that would work if the dataset were smaller, but the workbook either crashes / not enough memory, or calculates for too long a time. I'm guessing the solution is some clever VBA code to populate a new column with the list of unique values. If anyone is able to help with this code, I would be grateful.

Thank you again.

 

[kevin9999]

Does this do what you want? (Unique values put in column D - change destination to suit)

Option Explicit
Sub Frysk()
    Dim d As Object, arr, i As Long
    Set d = CreateObject("scripting.dictionary")
    arr = Range("A1", Cells(Rows.Count, "B").End(xlUp))
    For i = 1 To UBound(arr, 1)
        If arr(i, 2) = 1 Then d(arr(i, 1)) = 1
    Next i
    Range("D1").Resize(d.Count, 1).Value2 = Application.Transpose(d.keys)
End Sub

 

[Frysk]

Does this do what you want? (Unique values put in column D - change destination to suit)

Option Explicit
Sub Frysk()
    Dim d As Object, arr, i As Long
    Set d = CreateObject("scripting.dictionary")
    arr = Range("A1", Cells(Rows.Count, "B").End(xlUp))
    For i = 1 To UBound(arr, 1)
        If arr(i, 2) = 1 Then d(arr(i, 1)) = 1
    Next i
    Range("D1").Resize(d.Count, 1).Value2 = Application.Transpose(d.keys)
End Sub

Brilliant, thank you - it's great.

 

[kevin9999]

Happy to help & thanks for the feedback

 

[Akuini]

@kevin9999
The Transpose function has a limit of 65,536 items. Beyond this limit, it only retrieves the remaining items, unfortunately without raising an error.
Try this:

Sub test_Transpose_limit()
vb = Application.Transpose(Range("A1:A100000"))
Debug.Print UBound(vb)  'returns: 34464,  it's 100000 - 65536
End Sub

Therefore, it's advisable to include a check for this in your code, in case the result, i.e d.keys, surpasses that limit.

 

[kevin9999]

@kevin9999
The Transpose function has a limit of 65,536 items. Beyond this limit, it only retrieves the remaining items, unfortunately without raising an error.
Try this:

Sub test_Transpose_limit()
vb = Application.Transpose(Range("A1:A100000"))
Debug.Print UBound(vb)  'returns: 34464,  it's 100000 - 65536
End Sub

Therefore, it's advisable to include a check for this in your code, in case the result, i.e d.keys, surpasses that limit.

Thanks for the reminder @Akuini - I forgot all about that

 

[dermie_72]

I know this is showing as solved, however a simple formula might do the exact same thing, especially if the data is sorted. in A. If It starts in Row A2 (Assuming you have a heading), then in B2 add the following formula then filter by the identifier of 1

=IF(A2=A1,0,1)