I am newbie and I would like to loop in all the worksheets of a woorkbook performing this specific action: changing the color to cell with a specific string in it.
I’m currently using .Replace( I need MatchCase and lookat), unfortunately it replaces the text with the one searched, without regarding to che Case, so it’s chainging the string (e.g. if in the array it is lowercase and a string will be found as uppercase it will be changed to lowercase). The only way to bypass this is to use
MatchCase:= false and list all option, and it could be really unefficient.
Could I perform the same action using .find, or another function? Unfortunately I tried without success.
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
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
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
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