I have a workbook with two sheets. On Sheet A, I have changed the interior color of some cells. I would like to find cells in Sheet B with matching text and set them to have the
Sub MatchHighlight()
Dim wsHighlight As Worksheet
Dim wsData As Worksheet
Dim rngColor As Range
Dim rngFound As Range
Dim KeywordCell As Range
Dim strFirst As String
Set wsHighlight = Sheets("HR - Highlight")
Set wsData = Sheets("Full List")
With wsData.Columns("C")
For Each KeywordCell In wsHighlight.Range("C2", wsHighlight.Cells(Rows.Count, "C").End(xlUp)).Cells
Set rngFound = .Find(KeywordCell.Text, .Cells(.Cells.Count), xlValues, xlWhole)
If Not rngFound Is Nothing Then
strFirst = rngFound.Address
Set rngColor = rngFound
Do
Set rngColor = Union(rngColor, rngFound)
Set rngFound = .Find(KeywordCell.Text, rngFound, xlValues, xlWhole)
Loop While rngFound.Address <> strFirst
rngColor.Interior.Color = KeywordCell.Interior.Color
End If
Next KeywordCell
End With
End Sub