查找文本并更改颜色

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. (eg 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