Search and highlight word in cell

Hi All,

I have one task to do i.e., search the word in column A and highlight the same word in column B
for example...
column A contains "TEST": Do-not-use str
So, find TEST in column B and highlight this word in yellow.

This needs to be done for each column A cells.

Can you please provide any sample or references for this?

Thanks in advance!
ShailShin

Conditional formatting is probably best as stated above.

Does column A always contain a certain word, or a list of words, or is it different every time?

conditional based will not work here as column A contains different or same words.

Can you upload a sample workbook so we can see what sort of data you're working with?

please find attached sample data for this.

Thanks,
shailshin

Maybe:

Sub ShailShin()
Dim i As Long
Dim rcell As Range
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
For i = Range("A" & Rows.count).End(3)(1).Row To 2 Step -1
    For Each rcell In Range("B2:B" & Range("B" & Rows.count).End(3)(1).Row)
        If rcell.Text = Range("A" & i).Text Then
            rcell.Interior.ColorIndex = 6
        End If
    Next rcell
Next i
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Hi,

The column B word does not get highlighted in sample file...
Column A word "TEST" should get highlighted in column B cell word this is test message for TEST in you file.

Thanks,
shailshin

ShailShin

I can not open your attachment.

Try upload a sample workbook without zip.

Please find attached.

Thanks,
ShailShin

Do you want to search the word between the w-quotation mark in Col.B and highlight only such word?
If not, need to see your desired results.

Sub test()
    Dim r As Range, c As Range, ff As String, txt As String, m As Object
    Columns("b").Font.ColorIndex = xlAutomatic
    With CreateObject("VBScript.RegExp")
        .Global = True: .IgnoreCase = True
        For Each r In Range("a1", Range("a" & Rows.Count).End(xlUp))
            .Pattern = """([^""]+)"""
            If .test(r.Value) Then
                txt = .Execute(r.Value)(0).submatches(0)
                Set c = Columns("b").Find(txt)
                If Not c Is Nothing Then
                    ff = c.Address
                    Do
                        .Pattern = "\b" & txt & "\b"
                        For Each m In .Execute(c.Value)
                            c.Characters(m.firstindex + 1, m.Length).Font.ColorIndex = 5
                        Next
                        Set c = Columns("b").FindNext(c)
                    Loop Until c.Address = ff
                End If
            End If
        Next
    End With
End Sub

Hi,

Yes! this works as per the requirement.
Thanks a lot!