Find All Cells That Contain A Certain Value

[Admin]

Hi Rasm,

Try this code. It took only 3 secs to scan 280,000 cells and color the background.

Sub kTest()
    
    Dim strCellAddr(1 To 5000)  As String
    Dim ka, rngToSearch         As Range
    Dim i   As Long, j As Long, n As Long
    Dim txt As String
    
    Set rngToSearch = ActiveSheet.UsedRange
    
    Const SearchWord    As String = "red"
    
    Debug.Print Now
    ka = rngToSearch
    
    For i = 1 To UBound(ka, 1)
        For j = 1 To UBound(ka, 2)
            If InStr(LCase$(ka(i, j)), LCase$(SearchWord)) Then
                txt = txt & "," & Cells(i, j).Address(0, 0)
                If Len(txt) > 245 Then
                    n = n + 1
                    strCellAddr(n) = Mid$(txt, 2)
                    txt = vbNullString
                End If
            End If
        Next
    Next
    If Len(txt) > 1 Then
        n = n + 1
        strCellAddr(n) = Mid$(txt, 2)
        txt = vbNullString
    End If
                
    With rngToSearch
        For i = 1 To n
            .Range(CStr(strCellAddr(i))).Interior.Color = 10092543
        Next
    End With
    
    Debug.Print Now
    
End Sub