Find text and change color - excel

Question

I would like to loop all the worksheets of a workbook changing the color of a cell with a specific string in it.
I use .Replace (I need MatchCase and lookat).
It replaces the text without regarding Case. (e.g. if in the array it is lowercase and the string found is uppercase it will be changed to lowercase). The only way to bypass this is to use MatchCase:= false and list all options, and it could be really inefficient.
Could I perform the action using .Find or another function?
Sub CellMarked()
Dim fndlist As Variant, x As Integer, sht as worksheet
fndlist = Array("Column1", "Column2")
For Each sht In ActiveWorkbook.Worksheets
With sht
For x = LBound(fndlist) To UBound(fndlist)
.Cells.Replace What:=fndlist(x), Replacement:=fndlist(x), _
lookat:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, _
SearchFormat:=False, ReplaceFormat:=True
Application.ReplaceFormat.Font.Color = 255
Next x
End With
next sht
End Sub

Answer 1

you could use Find() method and build a helper Function:
Function GetCellsWithValue(sht As Worksheet, val As Variant, foundCells As Range) As Boolean
Dim found As Range
Dim firstAddress As String
With sht.UsedRange
Set foundCells = .Resize(1, 1).Offset(.Rows.Count) ' fill foundCells with a "dummy" found one to avoid 'If Not foundCells Is Nothing' check before any 'Union()' method call
Set found = .Find(what:=val, lookat:=xlPart, LookIn:=xlValues)
If Not found Is Nothing Then
firstAddress = found.Address
Do
Set foundCells = Union(foundCells, found)
Set found = .FindNext(found)
Loop While found.Address <> firstAddress
End If
Set foundCells = Intersect(.Cells, foundCells) ' get rid of the "dummy" found cell
End With
GetCellsWithValue = Not foundCells Is Nothing
End Function
that you could use in your "main" sub as follows:
Option Explicit
Sub CellMarked()
Dim fndlist As Variant, val As Variant, sht As Worksheet
Dim foundCells As Range
fndlist = Array("Column1", "Column2")
For Each sht In ActiveWorkbook.Worksheets
With sht
For Each val In fndlist
If GetCellsWithValue(sht, val, foundCells) Then foundCells.Font.Color = 255
Next
End With
Next sht
End Sub

Answer 2

Find Text Apply Fill
Sub CellMarked()
Dim rngFind As Range, rngU As Range
Dim fndlist As Variant
Dim strFirst As String
Dim i As Integer, x As Integer
fndlist = Array("Column1", "Column2")
For i = 1 To Worksheets.Count
With Worksheets(i)
For x = 0 To UBound(fndlist)
' Check if worksheet has no values.
If Not .Cells.Find("*", .Cells(.Rows.Count, Columns.Count), -4163, 2, 1) _
Is Nothing Then
' Find string.
Set rngFind = .Cells.Find(fndlist(x), _
.Cells(.Rows.Count, Columns.Count))
If Not rngFind Is Nothing Then
If Not rngU Is Nothing Then
Set rngU = Union(rngU, rngFind) ' All other occurrences.
Else
Set rngU = rngFind ' First occurrence.
End If
strFirst = rngFind.Address
' Check for other occurrences.
Do
Set rngFind = .Cells.FindNext(rngFind)
If rngFind.Address <> strFirst Then
Set rngU = Union(rngU, rngFind)
Else
Exit Do
End If
Loop
End If
End If
Next
' Apply formatting.
If Not rngU Is Nothing Then
rngU.Interior.Color = 255
' rngU.Font.Color = 255
Set rngU = Nothing
End If
End With
Next
End Sub

Answer 3

Change "strToFind" and try:
Option Explicit
Sub test()
Dim strToFind As String
Dim rng As Range, cell As Range
Dim ws As Worksheet
'String to Find is "Test"
strToFind = "Test"
With ThisWorkbook
For Each ws In .Worksheets
With ws
Set rng = .UsedRange
For Each cell In rng
If cell.Value = strToFind Then
cell.Interior.Color = RGB(255, 0, 0)
End If
Next cell
End With
Next ws
End With
End Sub