I have a Collection of 166 elements:Dim MyCollection As New CollectionMyCollection.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 IfNext iHowever, 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.
Loop through column cells and compare value with a Collection
vba;excel;collections
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 initializeIn 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 sec2. (Arr) - Total rows: 100,001 in  0.398 sec1. (Rng) - Total rows: 500,001 in 43.578 sec2. (Arr) - Total rows: 500,001 in  2.023 sec   Invalid cells: 77,780 (out of 100,000).the codeOption ExplicitPublic 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 IfEnd Sub