Conditional Formatting: Highlight only certain words in cell (text)?

[Attraktor]

Hi to all,

I know that you can highlight a cell or it's entire contents with a certain color, but can you highlight only certain portions of it's contents using Conditional Formatting?

A simple example: If cell A1 contains the text "The pink elephant has blue and green spots." and cell B1 contains the text "blue", using cell B1 as a reference, is there a way to highlight only the text "blue" in A1 with the color blue using Conditional Formatting?

Thanks in advance for any answer to this.


Marc.

 

[gcarv]

The following code worked really well for me but i still need a slight modification for it to work with what I'm doing..

Try this slight modification of the post #17 code on a copy of your workbook.

Sub Highliht_Words()
  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 = "\|{2,}"
  RX.Pattern = "\b(" & RX.Replace(Join(Application.Transpose(Range("B1", Range("B" & Rows.Count).End(xlUp)).Value), "|"), "|") & ")\b"
  Application.ScreenUpdating = False
  Columns("A").Font.ColorIndex = xlAutomatic
  For Each c In Range("A1", Range("A" & Rows.Count).End(xlUp))
    Set Mtchs = RX.Execute(c.Value)
    For Each itm In Mtchs
      c.Characters(Start:=itm.firstindex + 1, Length:=itm.Length).Font.Color = vbRed
    Next itm
  Next c
  Application.ScreenUpdating = True
End Sub

I have a list of watches on another sheet in column A that look like (in actuality there are many more)

5990

5711

5167

5726

5980

<tbody>
</tbody>

I want the code to highlight those numbers when they are the first in a word:

5990/1A-001
5711/1R-001
5146J-001 -> Need to figure out how to get this one to change to red as well
5980/1R-001

I tried changing the line of code with the RX.Pattern starting with "\b" but the closest i got was having it say " "|"), "|") & ")\d"
which made my cell text look like: 5711/1R-001 & 5146J-001. So I simply want to just color the text nothing adjacent to them

 

[Peter_SSs]

@ gcarv
Welcome to the MrExcel board!

If any of the following assumptions are not correct, & you can't adapt the code, please provide further details.
- Data to be highlighted is on 'Sheet1' column A
- List of numbers to check for, all 4-digit, are on 'Sheet2', starting at cell A2 and down with no blank cells in that range

Test in a copy of your workbook

Sub Highliht_Watches()
  Dim RX As Object, Mtch As Object
  Dim c As Range
  
  Set RX = CreateObject("VBScript.RegExp")
  With Sheets("Sheet2")
    RX.Pattern = "^(" & Join(Application.Transpose(.Range("A2", .Range("A" & .Rows.Count).End(xlUp)).Value), "|") & ")"
  End With
  Application.ScreenUpdating = False
  With Sheets("Sheet1")
    .Columns("A").Font.ColorIndex = xlAutomatic
    For Each c In .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
      Set Mtch = RX.Execute(c.Value)
      If Mtch.Count = 1 Then c.Characters(Start:=Mtch(0).firstindex + 1, Length:=Mtch(0).Length).Font.Color = vbRed
    Next c
  End With
  Application.ScreenUpdating = True
End Sub

 

[gcarv]

@ gcarv
Welcome to the MrExcel board!

If any of the following assumptions are not correct, & you can't adapt the code, please provide further details.
- Data to be highlighted is on 'Sheet1' column A
- List of numbers to check for, all 4-digit, are on 'Sheet2', starting at cell A2 and down with no blank cells in that range

Test in a copy of your workbook

Sub Highliht_Watches()
  Dim RX As Object, Mtch As Object
  Dim c As Range
  
  Set RX = CreateObject("VBScript.RegExp")
  With Sheets("Sheet2")
    RX.Pattern = "^(" & Join(Application.Transpose(.Range("A2", .Range("A" & .Rows.Count).End(xlUp)).Value), "|") & ")"
  End With
  Application.ScreenUpdating = False
  With Sheets("Sheet1")
    .Columns("A").Font.ColorIndex = xlAutomatic
    For Each c In .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
      Set Mtch = RX.Execute(c.Value)
      If Mtch.Count = 1 Then c.Characters(Start:=Mtch(0).firstindex + 1, Length:=Mtch(0).Length).Font.Color = vbRed
    Next c
  End With
  Application.ScreenUpdating = True
End Sub

So I ended up going in a different direction than the RegEx, let me know if you think im on the right track. The code is repeated twice since I wanted to have a different color for the watches that were going to be 2%.

 Dim i2 As Long
    Dim onepercent As String
    Dim seq As Variant


' The sequence contains the values to highlight
onepercent = "5990,5711,5724,5726,5980,5712,5168,5164,5167,5072,5062,5067,5068,DEEPSEA,BLK.BL.BZ,GREEN SUBMARINER," _
    & "SS WHT DAYTONA,SS BLK DAYTONA,OYSTFLEX,CERACHROM,SEA DWELLER,WG YACHT,18KY YACHT,18KY YAHT,18KW YACHT,18KW YAHT,PG BLK BZ.DL DTE,PG YACHT"


' Split sequence list,  so it can loop through each value in the array


Dim seqList() As String
seqList = Split(onepercent, ",")


' This loops through up to Row 20 to determine if the cell value contains a sequence value, if it does, then it highlights it red
For i2 = 2 To Cells(Rows.Count, 2).End(xlUp).Row
    Dim cellVal As String
    cellVal = Cells(i2, 2).Value 'Cells (i2, 2) --> i refers to row number and 2 refers to column number. So in this case I set it to B


    For Each seq In seqList
        Dim outcomeNum As Integer
        outcomeNum = InStr(cellVal, seq)


        If outcomeNum > 0 Then
            Cells(i2, 2).Characters(Start:=outcomeNum, Length:=Len(seq)).Font.Color = RGB(255, 0, 0) ' You can set color here or change it to something else
        End If


        Next seq


    Next i2
    
    Dim i3 As Long
    Dim twopercent As String
    Dim seq2 As Variant
    
    ' The sequence contains the values to highlight
twopercent = "SS SUB,SS BLK SUBMARINER,EXPLOR,SS . GMT-MASTII,SS/PG YACHT,S/PG YACHT,SS 18KR YACHT,SS YACHT,S/PLT YACHT," _
    & "S/ST PLT YACHT,SS/PLAT YACHT,S/18YG YACHT,S/ST PLAT"


' Split sequence list,  so it can loop through each value in the array


Dim seqList2() As String
seqList2 = Split(twopercent, ",")


' This loops through up to Row 20 to determine if the cell value contains a sequence value, if it does, then it highlights it blue
For i3 = 2 To Cells(Rows.Count, 2).End(xlUp).Row
    Dim cellVal2 As String
    cellVal2 = Cells(i3, 2).Value 'Cells (i3, 2) --> i refers to row number and 2 refers to column number. So in this case I set it to B


    For Each seq2 In seqList2
        Dim outcomeNum2 As Integer
        outcomeNum2 = InStr(cellVal2, seq2)


        If outcomeNum2 > 0 Then
            Cells(i3, 2).Characters(Start:=outcomeNum2, Length:=Len(seq2)).Font.Color = RGB(0, 0, 255) ' You can set the color here or change it to something else
        End If


        Next seq2


    Next i3

The reason for this was due to the criteria not always being 4 numbers, sometimes I need to highlight words as well. The code above worked well to do what i needed it to do. My only complaint was I did want to call upon a different sheet with the criteria, making it more user friendly to change what watches get 1% or 2%. I have a personal macrobook with all the macros i run at work, having the macro check in sheet "Watches List" in columns A for 1% and B for 2%.

 

[Peter_SSs]

The reason for this was due to the criteria not always being 4 numbers, sometimes I need to highlight words as well.

As a matter of interest, did you try my code anyway? If so, could we have some sample data and items in a list where it failed?

My reason for assuming 4 digits was simply that I didn't know if your list of items might include, say, 4567 and your data might include an item like "456789/1A-001" and I didn't know whether you would want it displayed as "456789/1A-001" or not since 4567 is not the whole number part at the start.

I don't have any meaningful data to test your code with, but I thought from your first description that the items being looked for were only the very first thing in the cell - at least you samples seemed to indicate that. Is that the case or might the text be anywhere in the cell?

I think for me to offer much more, I would need to see a more varied set of sample data and the items to highlight and the results expected.

 

[gcarv]

As a matter of interest, did you try my code anyway? If so, could we have some sample data and items in a list where it failed?

My reason for assuming 4 digits was simply that I didn't know if your list of items might include, say, 4567 and your data might include an item like "456789/1A-001" and I didn't know whether you would want it displayed as "456789/1A-001" or not since 4567 is not the whole number part at the start.

I don't have any meaningful data to test your code with, but I thought from your first description that the items being looked for were only the very first thing in the cell - at least you samples seemed to indicate that. Is that the case or might the text be anywhere in the cell?

I think for me to offer much more, I would need to see a more varied set of sample data and the items to highlight and the results expected.

Sure, I went ahead and tested your code and these were the results:

In my "Sheet 2", I had these values in column A, and the results in Sheet 1:

5990 5711 5724 5726 5980 5712 5168 5164 5167 5072 5062 5067 5068 DEEPSEA BLK.BL.BZ GREEN SUBMARINER SS WHT DAYTONA SS BLK DAYTONA OYSTFLEX CERACHROM SEA DWELLER WG YACHT 18KY YACHT 18KY YAHT 18KW YACHT 18KW YAHT PG BLK BZ.DL DTE PG YACHT <tbody> </tbody>

29MM 18KY YACHT-MASTER #20 ROLEX 40MM/SS . GMT-MASTII . BLK.BL.BZ.BR SS 5990/1A-001 BLK DL NAUTILUS 18KR 5711/1R-001 NAUTILUS 38.5MM 5168.ANNUAL CALEN 5164 GRAY.ARAB.DL 16X14 STR TUAPE ALLIGATOR 44MM/SS SEA-DW DEEPSEA.D-BLUE 5990 5711 5724 5726 5980 5712 5168 5164 5167 5072 5062 5067 5068 DEEPSEA BLK.BL.BZ GREEN SUBMARINER SS WHT DAYTONA SS BLK DAYTONA OYSTFLEX CERACHROM SEA DWELLER WG YACHT 18KY YACHT 18KY YAHT 18KW YACHT 18KW YAHT PG BLK BZ.DL DTE PG YACHT <tbody> </tbody>

<tbody>
</tbody>

So Column A here was the criteria and column B was the text to be highlighted. The red text is the text that changed and the blue is text that was supposed to but did not. But apparently only worked when the text was not in a cell on its own. Hope this is clear enough, if you need more examples let me know

 

[Peter_SSs]

But apparently only worked when the text was not in a cell on its own.

The issue wasn't whether the text was alone in a cell but whether the text was the first thing in a cell. Every single one of your original examples had the text to be highlighted as the very first part of the text & I thought, mistakenly apparently, that was a requirement.

Try my code again after removing the one red character below.

RX.Pattern = "^(" & Join(Application.Transpose(.Range("A2", .Range("A" & .Rows.Count).End(xlUp)).Value), "|") & ")"

Note that, as pointed out in my last post, if a cell in Sheet1 contained "15KR 2571124/1R" then it will appear as "15KR 2571124/1R" as the code is no longer looking only at the start of the cell for matching text. Is that an issue for you?

 

[gcarv]

Try my code again after removing the one red character below.

RX.Pattern = "^(" & Join(Application.Transpose(.Range("A2", .Range("A" & .Rows.Count).End(xlUp)).Value), "|") & ")"

Note that, as pointed out in my last post, if a cell in Sheet1 contained "15KR 2571124/1R" then it will appear as "15KR 2571124/1R" as the code is no longer looking only at the start of the cell for matching text. Is that an issue for you?

No that works fine, there should not be a case where number is mixed with other numbers. I tested the code and it works perfectly! Thank you for your help, I rather to use your code since I can have a user who knows nothing about excel change the criteria on a worksheet instead of in the code.

Now my next project is going to be to have Range("R2", .Range("R" & .Rows.Count).End(xlUp)) change to 1% (red text) or 2% (blue text) based off of the newly formatted cells in column B. (try that link below for an image example)

https://www.dropbox.com/s/onvos9g6hdln2cz/mr excel.PNG?dl=0

Do you know of any forums that already address this or should i start a new one and see if anyone can tackle it?

 

[Peter_SSs]

I tested the code and it works perfectly! Thank you for your help, ...

You are welcome. Glad it worked for you.

Now my next project is going to be to have Range("R2", .Range("R" & .Rows.Count).End(xlUp)) change to 1% (red text) or 2% (blue text) based off of the newly formatted cells in column B....

Do you know of any forums that already address this or should i start a new one and see if anyone can tackle it?

It looks like this is closely related to the question already addressed here so I think keep going in this thread.

However, I don't yet understand the new problem.

1. Are you able to show what the required results would look like for that sample? And give any further explanation about the logic of getting to those results?

2. Why does row 9 have some blue text? And did that blue text get there by another code like I provided above?

 

[gcarv]

1. Are you able to show what the required results would look like for that sample? And give any further explanation about the logic of getting to those results?

2. Why does row 9 have some blue text? And did that blue text get there by another code like I provided above?

So this is a small part of a longer macro that calculates commission for 20 or so employees. The commission structure is fairly complicated, using about 12 different schedules depending on the brand, profit margin, etc. I have the macro insert a formula that has many nested IFs to vlookup these different schedules and assigns the correct commission for each sale. It worked perfectly except there are special pieces that are always supposed to get 1% and 2%. I started out wanting to highlight those pieces red and blue respectively to draw attention to those so you could manually change them, but now I am thinking I can have the macro do that for me.

1) To answer your first question, check out the link below to see the before and after of the desired result. The goal would be to have the comm rate (Column R) change based off the cell color (1% for red and 2% for blue).

https://www.dropbox.com/s/kvc1k4nuzi99667/mr excel 2.png?dl=0

2) Here is the code that I'm using to get that blue text

Sub Highliht_Watches()  Dim RX As Object, Mtch As Object
  Dim c As Range
  
'red text (1%)
  Set RX = CreateObject("VBScript.RegExp")
  With Sheets("Sheet2")
'criteria for red text
    RX.Pattern = "(" & Join(Application.Transpose(.Range("A2", .Range("A" & .Rows.Count).End(xlUp)).Value), "|") & ")"
  End With
  Application.ScreenUpdating = False
  With Sheets("Sheet1")
    '.Columns("A").Font.ColorIndex = xlAutomatic

    For Each c In .Range("B2", .Range("B" & .Rows.Count).End(xlUp))
      Set Mtch = RX.Execute(c.Value)
      If Mtch.Count = 1 Then c.Characters(Start:=Mtch(0).firstindex + 1, Length:=Mtch(0).Length).Font.Color = vbRed
    Next c
  End With
'code to change to blue text (2%)    
With Sheets("Sheet2")
'criteria for blue text
    RX.Pattern = "(" & Join(Application.Transpose(.Range("B2", .Range("B" & .Rows.Count).End(xlUp)).Value), "|") & ")"
  End With
  Application.ScreenUpdating = False
With Sheets("Sheet1")
    '.Columns("A").Font.ColorIndex = xlAutomatic
    For Each c In .Range("b2", .Range("b" & .Rows.Count).End(xlUp))
      Set Mtch = RX.Execute(c.Value)
      If Mtch.Count = 1 Then c.Characters(Start:=Mtch(0).firstindex + 1, Length:=Mtch(0).Length).Font.Color = vbBlue
    Next c
  End With
  Application.ScreenUpdating = True
End Sub

Let me know if you have additional questions, I have at least one idea of how to accomplish this but I am limited in my know how of VBA. Thanks!

 

[Peter_SSs]

Try this. I've highlighted the added/changed sections.

Sub Highliht_Watches()
  Dim RX As Object, Mtch As Object
  Dim c As Range
  Dim dblPercent As Double
  
'red text (1%)
  Set RX = CreateObject("VBScript.RegExp")
  With Sheets("Sheet2")
'criteria for red text
    RX.Pattern = "(" & Join(Application.Transpose(.Range("A2", .Range("A" & .Rows.Count).End(xlUp)).Value), "|") & ")"
  End With
  dblPercent = 0.01
  Application.ScreenUpdating = False
  With Sheets("Sheet1")
    '.Columns("A").Font.ColorIndex = xlAutomatic

    For Each c In .Range("B2", .Range("B" & .Rows.Count).End(xlUp))
      Set Mtch = RX.Execute(c.Value)
      If Mtch.Count = 1 Then
        c.Characters(Start:=Mtch(0).firstindex + 1, Length:=Mtch(0).Length).Font.Color = vbRed
        c.Offset(, 3).Value = dblPercent
      End If
    Next c
  End With
'code to change to blue text (2%)
With Sheets("Sheet2")
'criteria for blue text
    RX.Pattern = "(" & Join(Application.Transpose(.Range("B2", .Range("B" & .Rows.Count).End(xlUp)).Value), "|") & ")"
  End With
  dblPercent = 0.02
  Application.ScreenUpdating = False
With Sheets("Sheet1")
    '.Columns("A").Font.ColorIndex = xlAutomatic
    For Each c In .Range("b2", .Range("b" & .Rows.Count).End(xlUp))
      Set Mtch = RX.Execute(c.Value)
      If Mtch.Count = 1 Then
        c.Characters(Start:=Mtch(0).firstindex + 1, Length:=Mtch(0).Length).Font.Color = vbBlue
        c.Offset(, 3).Value = dblPercent
      End If
    Next c
  End With
  Application.ScreenUpdating = True
End Sub