Home » excel » excel – Find text and change color

excel – Find text and change color

Posted by: admin May 14, 2020 Leave a comment

Questions:

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.

Many thanks

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
How to&Answers:

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:

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:

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