Highlighting words within a string if they appear on a list?

BDexcel

New Member
Joined
Jun 28, 2017
Messages
44
Can someone help please?

I have a list of boxes containing strings of text, I need to highlight any words appearing in these strings if they appear in my list... is this possible?

For example:

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Sentence [/TD]
[TD] List[/TD]
[/TR]
[TR]
[TD]My motorbike is yellow [/TD]
[TD]yellow[/TD]
[/TR]
[TR]
[TD]My car is red [/TD]
[TD]red[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]car[/TD]
[/TR]
</tbody>[/TABLE]

Hope this makes sense any help appreciate
 

Excel Facts

What is the last column in Excel?
Excel columns run from A to Z, AA to AZ, AAA to XFD. The last column is XFD.
Try this:-
Code:
[COLOR="Navy"]Sub[/COLOR] MG14Jun53
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, R [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("B2"), Range("B" & Rows.Count).End(xlUp))
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng.Offset(, -1)
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] R [COLOR="Navy"]In[/COLOR] Rng
            [COLOR="Navy"]If[/COLOR] InStr(Dn.Value, R.Value) > 0 [COLOR="Navy"]Then[/COLOR]
                Dn.Characters(InStr(Dn.Value, R.Value), Len(R.Value)).Font.Color = vbRed
            [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]Next[/COLOR] R
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Try this:-
Code:
[COLOR=Navy]Sub[/COLOR] MG14Jun53
[COLOR=Navy]Dim[/COLOR] Rng [COLOR=Navy]As[/COLOR] Range, Dn [COLOR=Navy]As[/COLOR] Range, R [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Set[/COLOR] Rng = Range(Range("B2"), Range("B" & Rows.Count).End(xlUp))
    [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng.Offset(, -1)
        [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] R [COLOR=Navy]In[/COLOR] Rng
            [COLOR=Navy]If[/COLOR] InStr(Dn.Value, R.Value) > 0 [COLOR=Navy]Then[/COLOR]
                Dn.Characters(InStr(Dn.Value, R.Value), Len(R.Value)).Font.Color = vbRed
            [COLOR=Navy]End[/COLOR] If
        [COLOR=Navy]Next[/COLOR] R
[COLOR=Navy]Next[/COLOR] Dn
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Regards Mick

Hi Mike,

Thanks so much!

This worked but the only limitation i'm having is its case sensitive... for example it wont highlight if the word was 'Yellow' due to the caps or if it was partial such as 'yello'

Is there anyway to get around this?

Appreciate your help mate
 
Last edited:
Upvote 0
This will sort the "case sensitive" bit, but not the "Yello" ??
Code:
[COLOR="Navy"]Sub[/COLOR] MG14Jun08
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, R [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("B2"), Range("B" & Rows.Count).End(xlUp))
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng.Offset(, -1)
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] R [COLOR="Navy"]In[/COLOR] Rng
            [COLOR="Navy"]If[/COLOR] InStr(1, Dn.Value, R.Value, vbTextCompare) > 0 [COLOR="Navy"]Then[/COLOR]
                Dn.Characters(InStr(1, Dn.Value, R.Value, vbTextCompare), Len(R.Value)).Font.Color = vbRed
            [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]Next[/COLOR] R
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
This will sort the "case sensitive" bit, but not the "Yello" ??
Code:
[COLOR=Navy]Sub[/COLOR] MG14Jun08
[COLOR=Navy]Dim[/COLOR] Rng [COLOR=Navy]As[/COLOR] Range, Dn [COLOR=Navy]As[/COLOR] Range, R [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Set[/COLOR] Rng = Range(Range("B2"), Range("B" & Rows.Count).End(xlUp))
    [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng.Offset(, -1)
        [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] R [COLOR=Navy]In[/COLOR] Rng
            [COLOR=Navy]If[/COLOR] InStr(1, Dn.Value, R.Value, vbTextCompare) > 0 [COLOR=Navy]Then[/COLOR]
                Dn.Characters(InStr(1, Dn.Value, R.Value, vbTextCompare), Len(R.Value)).Font.Color = vbRed
            [COLOR=Navy]End[/COLOR] If
        [COLOR=Navy]Next[/COLOR] R
[COLOR=Navy]Next[/COLOR] Dn
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Regards Mick


Thanks so much Mike! works great :)

One last thing is it possible to add some kind of .Font.Bold = True so the results also bold?

Appreciate your help with this
 
Upvote 0
Try this:-
Code:
[COLOR="Navy"]Sub[/COLOR] MG14Jun58
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, R [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("B2"), Range("B" & Rows.Count).End(xlUp))
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng.Offset(, -1)
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] R [COLOR="Navy"]In[/COLOR] Rng
            [COLOR="Navy"]If[/COLOR] InStr(1, Dn.Value, R.Value, vbTextCompare) > 0 [COLOR="Navy"]Then[/COLOR]
                [COLOR="Navy"]With[/COLOR] Dn.Characters(InStr(1, Dn.Value, R.Value, vbTextCompare), Len(R.Value)).Font
                    .Color = vbRed
                    .Bold = True
                [COLOR="Navy"]End[/COLOR] With
            [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]Next[/COLOR] R
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Comments
- If you want "yello" to be highlighted as well as "yellow" you would need to include them both in the second column list (subject to my next point)
- In your first post, you talked about "words" being highlighted. The suggested code does not account for "words" but simply text strings. For example, with your 3 'List' words in post 1, this happens would happen.
Your scarring has reduced
becomes
Your scarring has reduced
Perhaps that is what you want and you didn't mean "words", but if you did, see my alternate code below.
- The suggested code only operates on as many rows in column A as there are in column B. That is, If 10 rows in column A and 3 rows in column B, the last 7 rows in col A will not be checked.
- The suggested code only highlights the first occurrence of a string. For example
My car is red but your car is blue
becomes
My car is red but your car is blue
ie The second "car" is not highlighted

My suggestion, to process all rows in column A and only look for "word" matches is
Code:
Sub HighlightWords()
  Dim RX As Object, Mtchs As Object
  Dim itm As Variant
  Dim c As Range
  
  
  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True
  RX.IgnoreCase = True
  RX.Pattern = "\b(" & Join(Application.Transpose(Range("B2", Range("B" & Rows.Count).End(xlUp)).Value), "|") & ")\b"
  Application.ScreenUpdating = False
  Columns("A").Font.ColorIndex = xlAutomatic
  Columns("A").Font.Bold = False
  For Each c In Range("A2", Range("A" & Rows.Count).End(xlUp))
    Set Mtchs = RX.Execute(c.Value)
    For Each itm In Mtchs
      With c.Characters(Start:=itm.firstindex + 1, Length:=itm.Length)
        .Font.Color = vbRed
        .Font.Bold = True
      End With
    Next itm
  Next c
  Application.ScreenUpdating = True
End Sub
 
Last edited:
Upvote 0
Comments
- If you want "yello" to be highlighted as well as "yellow" you would need to include them both in the second column list (subject to my next point)
- In your first post, you talked about "words" being highlighted. The suggested code does not account for "words" but simply text strings. For example, with your 3 'List' words in post 1, this happens would happen.
Your scarring has reduced
becomes
Your scarring has reduced
Perhaps that is what you want and you didn't mean "words", but if you did, see my alternate code below.
- The suggested code only operates on as many rows in column A as there are in column B. That is, If 10 rows in column A and 3 rows in column B, the last 7 rows in col A will not be checked.
- The suggested code only highlights the first occurrence of a string. For example
My car is red but your car is blue
becomes
My car is red but your car is blue
ie The second "car" is not highlighted

My suggestion, to process all rows in column A and only look for "word" matches is
Code:
Sub HighlightWords()
  Dim RX As Object, Mtchs As Object
  Dim itm As Variant
  Dim c As Range
  
  
  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True
  RX.IgnoreCase = True
  RX.Pattern = "\b(" & Join(Application.Transpose(Range("B2", Range("B" & Rows.Count).End(xlUp)).Value), "|") & ")\b"
  Application.ScreenUpdating = False
  Columns("A").Font.ColorIndex = xlAutomatic
  Columns("A").Font.Bold = False
  For Each c In Range("A2", Range("A" & Rows.Count).End(xlUp))
    Set Mtchs = RX.Execute(c.Value)
    For Each itm In Mtchs
      With c.Characters(Start:=itm.firstindex + 1, Length:=itm.Length)
        .Font.Color = vbRed
        .Font.Bold = True
      End With
    Next itm
  Next c
  Application.ScreenUpdating = True
End Sub

Thanks so much for the reply Peter, this works perfect for my needs :)

Can i ask one thing? Is it possible to amend your code so it captures my partial searches also? As you advised it may give some false positives but currently it is missing some of the data i need captured.
 
Upvote 0
Thanks so much for the reply Peter, this works perfect for my needs :)
Great! :)


Is it possible to amend your code so it captures my partial searches also? As you advised it may give some false positives but currently it is missing some of the data i need captured.
I don't understand what you are wanting in relation to partial matches. Can you give some varied sample data (columns A & B) and the expected results like you did in post #1 that demonstrate what you want and how the current code misses some of the data you want? Any further explanation in relation to that sample data may also help clarify.

BTW, best not to fully quote long posts as it makes the thread harder to read/navigate and just occupies storage space needlessly. If you want to quote, quote small, relevant parts only.
 
Last edited:
Upvote 0
Thanks Peter,

Appreciate the assistance and the advice.

As I said the way you helped me with works so thanks so much! To make it absolutely perfect, it would be amazing if the code picked up 'partial' matches as demonstrated below:

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Sentence[/TD]
[TD]List[/TD]
[/TR]
[TR]
[TD]There was one investigation[/TD]
[TD]Investigat[/TD]
[/TR]
[TR]
[TD]This needed to be investigated[/TD]
[TD]Frustrat[/TD]
[/TR]
[TR]
[TD]The customer was Frustrated[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]There was Frustration from the staff[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Hope this makes more sense, if not possible its grand but if it was then this would make it perfect for my needs :)
 
Last edited:
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top