Find All Cells That Contain A Certain Value

[Rasm]

I have a column with either the Value "True" or "False" - I use the code below to highlight the cells with the value "True" by changing the backcolor. It all works great - except when I get to having found 10K plus values it really slows down. When I hit 20K it is very slow. The RED code is where it slows down - If I rem out that part it keeps up the speed.
Any suggestions. I modified code posted by VoG on MrExcel - Thanks VoG.

I guess the lookat:=xlWhole - should be changed to xlpart - but not sure how to do that - I assume you can set the Columns/Rows to limit the search to.


My second question is - if say the values in the cells were

blue shirt, red socks, blue pants, black shoes, blue shoes and so on

how can I find all the cells containing the word blue.



Public Sub FindValueX(ByRef WhatToFind As String, ByRef WhatBook As String, ByRef WhatSheet As String, ByRef FirstColToSearch As Long, ByRef LastColToSearch As Long, ByRef HighLightFound As Boolean, ByVal FoundRange As Range)
If Trim(WhatToFind) = "" Then
strMsg = "You have not specified a 'value' to search for."
intMsgType = vbOKOnly
intResponse = MsgBox(strMsg, intMsgType, "Searching for Value")
Exit Sub
End If
If Trim(WhatBook) = "" Then WhatBook = ActiveWorkbook.Name
If Trim(WhatSheet) = "" Then WhatSheet = ActiveSheet.Name
Dim tempcell As Range, Found As Range
Dim FirstRow As Long, FirstCol As Long
With Workbooks(WhatBook).Worksheets(WhatSheet).UsedRang e
ColLast = .Rows(.Rows.Count).Row
LastRow = .Rows(.Rows.Count).Row
End With
Set Found = Workbooks(WhatBook).Worksheets(WhatSheet).Range("A1")
Set tempcell = Cells.Find(What:=WhatToFind, After:=Found, LookIn:=xlValues, lookat:=xlWhole)
If tempcell Is Nothing Then
MsgBox prompt:="The value '" & WhatToFind & ", cannot be found"
Exit Sub
Else
Set Found = tempcell
Set FoundRange = Found
End If
FirstRow = Found.Row
FirstCol = Found.Column
Along = 1
AAlong = 0
Do
Set tempcell = Cells.FindNext(After:=Found)
If tempcell.Row = FirstRow And tempcell.Column = FirstCol Then Exit Do
Set Found = tempcell
If tempcell.Column >= FirstColToSearch And tempcell.Column <= LastColToSearch Then
Set FoundRange = Application.Union(FoundRange, Found)
If Along > 200 Then
Application.StatusBar = "Finding '" & WhatToFind & "' (" & AAlong & ")"
Along = 1
End If
Along = Along + 1
AAlong = AAlong + 1
End If
Loop
If HighLightFound Then
FoundRange.Interior.Color = &HC0FFFF 'Light Yellow
Else
FoundRange.Interior.ColorIndex = xlNone
End If
Application.StatusBar = "Completed"
End Sub

[Rasm]

ahhh the xlpart is the search string - so that finds Blue - so now I only have the speed issue left

[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

[Rasm]

execellent - tyvm - that does the trick