Find and highlight/bold/underline/colour a block of matching text (is this possible?)

Hi,

I would like to create a macro that will search words in Column A against Column B for text, and once found, will highlight the match in column B. Is this possible?

As it is easier to show an example, I have created an example of what I'm trying to do. Please kindly refer to the example and guide me along.. Thank you very much!

Hello Joelhuang,

If you are using this formula in conditional formatting, this will highlight the whole cell, not the particular word. if you want to highligh or Bold the words, would require VBA, hope some one will get to you.

Select the range, B5:B10, then try this formula in CF,

=LOOKUP(40000,SEARCH(SUBSTITUTE(TRIM(MID(SUBSTITUTE(" "&TRIM($A5)," ",REPT(" ",255)),ROW(INDEX($A:$A,1):INDEX($A:$A,LEN(TRIM($A5))-LEN(SUBSTITUTE(TRIM($A5)," ",""))+1))*254,255)),"!",""),$B5))

Choose the format.

Sub Hilite()

    Dim rngTextOrig As Range
    Dim rngTextMatch As Range
    Dim lngIndex As Long
    Dim vntWord As Variant
    Dim lngPos As Long
    
    Set rngTextOrig = Range("A5:A10")
    Set rngTextMatch = rngTextOrig.Offset(0, 1)
    
    For lngIndex = 1 To rngTextOrig.Cells.Count
        For Each vntWord In Split(rngTextOrig.Cells(lngIndex).Value, " ")
            lngPos = InStr(1, rngTextMatch.Cells(lngIndex).Value, vntWord, vbTextCompare)
            If lngPos > 0 Then
                With rngTextMatch.Cells(lngIndex).Characters(lngPos, Len(vntWord))
                    .Font.Bold = True
                    .Font.Color = vbRed
                End With
            End If
        Next
    Next
            
End Sub

Sub Hilite()

    Dim rngTextOrig As Range
    Dim rngTextMatch As Range
    Dim lngIndex As Long
    Dim vntWord As Variant
    Dim lngPos As Long
    Dim lngOrigPos As Long
    
    Set rngTextOrig = Range("A5:A10")
    Set rngTextMatch = rngTextOrig.Offset(0, 1)
    
    For lngIndex = 1 To rngTextOrig.Cells.Count
        lngOrigPos = 1
        For Each vntWord In Split(rngTextOrig.Cells(lngIndex).Value, " ")
            lngPos = InStr(1, rngTextMatch.Cells(lngIndex).Value, vntWord, vbTextCompare)
            If lngPos > 0 Then
                With rngTextMatch.Cells(lngIndex).Characters(lngPos, Len(vntWord))
                    .Font.Bold = True
                    .Font.Color = vbRed
                End With
                
                lngPos = InStr(lngOrigPos, rngTextOrig.Cells(lngIndex).Value, vntWord, vbTextCompare)
                If lngPos > 0 Then
                    With rngTextOrig.Cells(lngIndex).Characters(lngPos, Len(vntWord))
                        .Font.Bold = True
                        .Font.Color = vbRed
                    End With
                    lngOrigPos = lngPos + Len(vntWord) + 1
                End If
            End If
        Next
    Next
            
End Sub

If you select the first column of the table then you can use

'''  Set rngTextOrig = Range("A5:A10")
  Set rngTextOrig = Selection

Selection of columns B and G would be a non contiguous selection and require the use of the Areas object.

try this (untested),

If Selection.Areas.Count > 1 then
    Set rngTextOrig = Selection.Areas(1).columns(1)
    Set rngTextMatch = Selection.Areas(2).columns(1)
else
    Set rngTextOrig = Selection.Columns(1)
    Set rngTextMatch = rngTextOrig.Offset(0, 1)
end if

You need to loop rather than do the code once.

Sub Hilite()

    Dim rngTextOrig As Range
    Dim rngTextMatch As Range
    Dim lngIndex As Long
    Dim vntWord As Variant
    Dim lngPos As Long
    Dim lngOrigPos As Long
    
    Set rngTextOrig = Range("A5:A10")
    Set rngTextMatch = rngTextOrig.Offset(0, 1)
    
    For lngIndex = 1 To rngTextOrig.Cells.Count
        lngOrigPos = 1
        For Each vntWord In Split(rngTextOrig.Cells(lngIndex).Value, " ")
            lngPos = InStr(1, rngTextMatch.Cells(lngIndex).Value, vntWord, vbTextCompare)
            If lngPos > 0 Then
                Do While lngPos > 0
                    With rngTextMatch.Cells(lngIndex).Characters(lngPos, Len(vntWord))
                        .Font.Bold = True
                        .Font.Color = vbRed
                    End With
                    lngPos = InStr(lngPos + 1, rngTextMatch.Cells(lngIndex).Value, vntWord, vbTextCompare)
                Loop
            
                lngPos = InStr(lngOrigPos, rngTextOrig.Cells(lngIndex).Value, vntWord, vbTextCompare)
                If lngPos > 0 Then
                    With rngTextOrig.Cells(lngIndex).Characters(lngPos, Len(vntWord))
                        .Font.Bold = True
                        .Font.Color = vbRed
                    End With
                    lngOrigPos = lngPos + Len(vntWord) + 1
                End If
            End If
        Next
    Next
            
End Sub

So brilliant! Thank you :D

How about this: it is best to keep it to scan for A1-A10, as it will take too much time and memory to run for A10000 all the time. However, the number of data ranges from A500 to A1000.

Can I do this to make it semi-automatic?

eg.

1) I will do a check to see what is the last cell of Column A that contains data.

Set RngTextLastCell = Last cell of Column A that contains data

2) The code will then be:

Set rngTextOrig = Range("A5:RngTextLastCell")

May I know if this is possible too? I tried reading vba for dummies, but don't think I saw the method of detecting the last cell being taught..

Currently, I have the following as a temporary measure:

MsgBox ("Each check only scans for first 1000 lines. If data contains more than that, please re-run the macro and continue from the last line")