Color partial text in cell - VBA

[khen1013]

I am brand new to this forum and relatively new to VBA so I apologize if this is not the correct way to go about this. I’ve searched all over and couldn’t find clear cut answers (or at least answers that I understood) so I’m hoping this will help.

I’m trying to color part of the text in a cell. If a cell has ML or OZ or MCG in any part of the worksheet, I want it to be changed to red (or any color really). I’ve seen a lot of answers that use LEN and substrings and etc. but I’m confused about the characters(start,length) property. I don’t know in what part of the cell those letters will be or how many letters even. Can someone explain this or direct me to somewhere that can?
Thank you!

 

[nlhu]

It shouldn't.

You did not address these aspects of my previous post.



BTW, sample data best provided with XL2BB so that we can actually test with it.

Sorry about that, here is the sample data set along with the code. I tried adding an if statement inside the loop to use 2 different colors and it worked at first as well, but when error occurs I reverse back to the original code and only include the range (K1:K151) below.

Call HighlightWordOrPhrase("K1:K151")

Sub HighlightWordOrPhrase(col As String)
    Dim wrd As Variant
    wrd = Array("Active", "Idle", "Connect", "OpenSent", "OpenConfirm") 'enter the words or phrases to highlight between the quote marks
    Dim c As Range, x As Variant, i As Long
    Application.ScreenUpdating = False
    For Each c In ActiveSheet.Range(col)
        For i = LBound(wrd) To UBound(wrd)
            x = InStr(1, c.Value, wrd(i), vbTextCompare)
            If x > 0 Then
            Do
                c.Characters(x, Len(wrd(i))).Font.Color = vbRed
                x = InStr(x + Len(wrd(i)) - 1, c.Value, wrd(i), vbTextCompare)
            Loop While x > 0
        End If
        Next i
    Next c
    c.ClearContents
    Application.ScreenUpdating = True
End Sub

tiger#show bgp neigh bri | inc phoenix
Tue Aug 22 20:11:53.019 CET
123.123.123.123         0  1000 phoenix    29w0d Established
2001:1000:1080:ca7::2    0  1000 phoenix    29w0d Established

tiger#show bgp neigh bri | inc panther
Tue Aug 22 21:58:35.504 CET
111.111.111.111         0 2000 panther              1y51w Active     
111.111.111.112         0 2000 panther              1y10w Established
2001:1000:1080:186a::2    0 2000 panther           00:00:00 Active

tiger#show bgp neigh bri | inc lion
Tue Aug 22 22:09:13.065 CET
222.222.222.221        0 2304 lion                      9w5d Established
2001:1000:1080:147e::2    0 2304 lion                      9w5d Established

 

[Peter_SSs]

I presume that second 'VBA Code' is meant to be the sample data but clearly that looks nothing like an Excel worksheet.
Can you post that again with XL2BB as suggested earlier?

 

[nlhu]

I presume that second 'VBA Code' is meant to be the sample data but clearly that looks nothing like an Excel worksheet.
Can you post that again with XL2BB as suggested earlier?

Hello, I cannot install XL2BB. The second vbcode is the data and each cell contains those 4 (or 5) lines. All I want to do is to change color for the status "Active", "Idle", "Connect", "OpenSent", "OpenConfirm" to red.

 

[Peter_SSs]

Hello, I cannot install XL2BB.

In that case simply copy the small section of the worksheet and paste directly in the forum and tell us what the actual range is.
Example: This is A2:B4

a	1​
s	2​
d	3​

 

[nlhu]

This is K1:K4. Ideally Established is green and other statuses would be red. The maximum range I have for the spreadsheet is K1:K151

tiger#show bgp neigh bri | inc phoenix Tue Aug 22 20:11:53.019 CET 123.123.123.123 0 1000 phoenix 29w0d Established 2001:1000:1080:ca7::2 0 1000 phoenix 29w0d Established

tiger#show bgp neigh bri | inc panther Tue Aug 22 21:58:35.504 CET 111.111.111.111 0 2000 panther 1y51w Active 111.111.111.112 0 2000 panther 1y10w Established 2001:1000:1080:186a::2 0 2000 panther 00:00:00 Active

tiger#show bgp neigh bri | inc lion Tue Aug 22 22:09:13.065 CET 222.222.222.221 0 2304 lion 9w5d Established 2001:1000:1080:147e::2 0 2304 lion 9w5d Established

tiber#show bgp neighbor brief | inc bird Wed Aug 23 09:04:42.854 CEST 23.232.213.121 0 1039 bird 00:01:01 Established 0 1039 bird 00:00:00 Idle

 

[Peter_SSs]

Thanks for the sample data.

I do not get the error that you reported in post #7. Instead I get

and that is because of the line that you have added that was not in the original code ..

        End If
        Next i
    Next c
    c.ClearContents
    Application.ScreenUpdating = True
End Sub

 

[nlhu]

Thanks for your response, Peter. I added that line as an effort to fix the other issue. So far it doesn't do anything to my file.

So I use this same script for different project, and I noticed first time I run this it works right away, and the odd thing was another file when I open also works automatically without having the right script in it. Could it be because this script trying to format / color the text from another sheet and cause this issue?

 

[Peter_SSs]

Could it be because this script trying to format / color the text from another sheet and cause this issue?

Hard to tell. It could relate to how/when the code is being called/triggered. In post #11 you have the following line by itself.

Call HighlightWordOrPhrase("K1:K151")

That line cannot exist alone like that so what is the rest of the code surrounding that call and where (ie what workbook and what module) is that code placed?
Also, where is the HighlightWordOrPhrase code placed?

 

[nlhu]

Hello, the function is called when the sheet is activated. I'm not sure how else to best call for it. Please find below the rest of the code for this worksheet. I also tried to place HighlightWordOrPhrase code under a separate module (to re-use for another worksheet) to test out but that doesn't change anything.

Option Explicit

Private Sub Worksheet_Activate()
    Call HighlightWordOrPhrase("K1:K151")
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Target.Calculate
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    ActiveSheet.Hyperlinks.Delete
End Sub

Sub HighlightWordOrPhrase(col As String)
    Dim wrd As Variant
    wrd = Array("Active", "Idle", "Connect", "OpenSent", "OpenConfirm") 'enter the words or phrases to highlight between the quote marks
    Dim c As Range, x As Variant, i As Long
    Application.ScreenUpdating = False
    For Each c In ThisWorkbook.ActiveSheet.Range(col)
        For i = LBound(wrd) To UBound(wrd)
            x = InStr(1, c.Value, wrd(i), vbTextCompare)
            If x > 0 Then
            Do
                c.Characters(x, Len(wrd(i))).Font.Color = vbGreen
                x = InStr(x + Len(wrd(i)) - 1, c.Value, wrd(i), vbTextCompare)
            Loop While x > 0
        End If
        Next i
    Next c
    Application.ScreenUpdating = True
End Sub

 

[Peter_SSs]

Thanks for the code.

You said earlier "first time I run this". Given that the code is called automatically when the worksheet is activated, I am not sure what is meant by that phrase.

I am also not sure why this would be in a Worksheet_Activate code but then I am not familiar with what is going on in your workbook or how the workbook is being used.

In any case, I have not been able to produce any unusual behaviour from the code.