Loop through column cells and compare value with a Collection

I have a Collection of 166 elements:

Dim MyCollection As New Collection
MyCollection.Add ("%")
MyCollection.Add ("%O")
MyCollection.Add ("D")
MyCollection.Add ("CMS")
...

I want to compare them to the value of the cells in a column. If the value of a cell is not in MyCollection, I change the background color to red.

For i = 2 To lastRow
    IsValid = False
    For Each Unit In MyCollection
        If Range("A" & i).value = Unit Then
            IsValid = True
        End If
    Next Unit
    If Not IsValid Then
        Range("A" & i).Interior.Color = 192
    End If
Next i

However, it takes a long time to finish executing when there is a large number of row and I would like to improve this. Maybe by using something else than a Collection and some VBA functions.

For a lot of data dictionaries are faster than collections, and much more convenient as @RubberDuck mentioned. Lookup times are almost instantaneous, IF you do a lot of lookups, but both collections and dictionaries are slow to initialize

In your case though, the lookups are insignificant. The main issue is caused by updating the cell format in every iteration. I converted the range to an array to minimize interaction with the sheet. Here are the results using the same data set:

1. (Rng) - Total rows: 100,001 in  8.851 sec
2. (Arr) - Total rows: 100,001 in  0.398 sec

1. (Rng) - Total rows: 500,001 in 43.578 sec
2. (Arr) - Total rows: 500,001 in  2.023 sec

   Invalid cells: 77,780 (out of 100,000)

.

the code

Option Explicit

Public Sub CompareValues()

    Const MAX_SZ    As Byte = 240
    Const COL_ID    As Byte = 1
    Const COL_LTR   As String = "A"
    Const FIRST_ROW As Byte = 2

    Const SRCH_LST  As String = "%,%O,D,CMS"
    Const LST_START As Byte = 0
    Const LST_END   As Byte = 3 '165

    Dim ws As Worksheet
    Dim thisRow As Long
    Dim thisItm As Long
    Dim invalidSet As Long
    Dim tmp As String
    Dim lastRow As Long
    Dim colArr As Variant
    Dim searchItem As Variant
    Dim isValid As Boolean
    Dim invalidArr() As String

    Set ws = ActiveWorkbook.Worksheets("Sheet1")
    With ws
        lastRow = .Cells(.Rows.Count, COL_ID).End(xlUp).Row
        colArr = .Range(.Cells(FIRST_ROW, COL_ID), .Cells(lastRow, COL_ID)).Value2
    End With
    searchItem = Split(SRCH_LST, ",")
    ReDim Preserve invalidArr(lastRow)
    invalidSet = 0

    For thisRow = 1 To lastRow - FIRST_ROW + 1
        isValid = False
        For thisItm = LST_START To LST_END  'compare
            If colArr(thisRow, COL_ID) = searchItem(thisItm) Then
                isValid = True
                Exit For
            End If
        Next
        If Not isValid Then     'if not valid build string of addresses (A1,A3,A7,...)
            tmp = tmp & COL_LTR & thisRow + FIRST_ROW - 1 & ","
            If Len(tmp) > MAX_SZ Then               'if string length > 240, split it
                invalidArr(invalidSet) = Left(tmp, Len(tmp) - 1)   'remove last comma
                invalidSet = invalidSet + 1
                tmp = vbNullString
            End If
        End If
    Next

    If Len(tmp) > 0 Or invalidSet > 0 Then      'if there are invalid values
        Dim totalSets As Long
        totalSets = invalidSet

        If Len(tmp) > 0 Then                    'store the last set, if tmp not empty
            invalidArr(invalidSet) = Left(tmp, Len(tmp) - 1)
        Else
            totalSets = totalSets - 1
        End If
        ReDim Preserve invalidArr(totalSets)    'cleanup (not needed)
        With ws
            For invalidSet = 0 To totalSets     'change cell colors in sets of ranges
                .Range(invalidArr(invalidSet)).Interior.Color = 192
            Next
        End With
    End If

End Sub

StackExchange Code Review Q#101511, answer score: 8