1

I have strings that look like this:

DTTGGRKDVVNHCGKKYKDK
RKDVVNHCGKKYKDKSKRAR

What I want to do is to highlight the region with bold and red font. Resulting this:

enter image description here

I tried the following code using LIKE operator in Excel VBA but it breaks at this line Set MC = .Execute(C.Text)

Option Explicit
Sub boldSubString()
    Dim R As Range, C As Range
    Dim MC As Object    

    Set R = Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))

    For Each C In R
        C.Font.Bold = False
        If C.Text Like "KK*K" Or C.Text Like "KR*R"  Then
            Set MC = .Execute(C.Text)
            C.Characters(MC(0).firstindex + 1, MC(0).Length).Font.Bold = True
        End If
    Next C    

End Sub

What's the right way to do it? I'm using Mac Excel Version 15.31

7
  • 1
    What is .Execute referring to here? This half looks like a Regular Expression-type approach, without any RegExp object (which in any case would not be available on a Mac) Commented Feb 4, 2019 at 4:13
  • @TimWilliams You're right it's based on Regex. I based it on this code previously: stackoverflow.com/questions/51130741/… I'm not sure how to go about it without Regex. That's why I'm going for "LIKE" Operator. Commented Feb 4, 2019 at 4:18
  • The Like Operator works as expected. But it only returns true if a match was found and false if not. It has nothing comparable to regex which is able getting the matching string parts too. So either you will using regex or you needs finding your matches another way. InStr function would be a good start then. Commented Feb 4, 2019 at 4:39
  • @Siddharth Rout: He is using Mac Excel. I suspect a Mac is not able creating ActiveX object as CreateObject("VBScript.RegExp")? Commented Feb 4, 2019 at 7:17
  • In your previous question, the regex you showed, and the examples, indicated a fixed length pattern. But the wildcard-including pattern you are using with the Like operator in this question indicates a variable length pattern. Which is it? Commented Feb 6, 2019 at 20:36

2 Answers 2

3

Without Regular Expressions, you can try the following. I've not tested it extensively but it does seem to work even with multiple matching substrings within the same string.

Examine VBA HELP for the functions that are being used, so you understand how this works, and also how to construct proper patterns to be used with the Like operator, in case you need to expand the list of possible patterns.

Option Explicit
Sub boldSS()
    Dim WS As Worksheet
    Dim R As Range, C As Range
    Dim sPatterns(1) As String
    Dim I As Long, J As Long

sPatterns(0) = "KR?R"
sPatterns(1) = "KK?K"

Set WS = Worksheets("sheet1")
With WS
    Set R = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With

For Each C In R

        'Reset to default
        With C.Font
            .Bold = False
            .Color = vbBlack
        End With

    For I = 0 To UBound(sPatterns)
        If C Like "*" & sPatterns(I) & "*" Then
            For J = 1 To Len(C) - Len(sPatterns(I)) + 1
                If Mid(C, J, Len(sPatterns(I))) Like sPatterns(I) Then
                    With C.Characters(J, Len(sPatterns(I))).Font
                        .Bold = True
                        .Color = vbRed
                    End With
                    If J < Len(C) - 3 Then
                        J = J + 3
                    Else
                        Exit For
                    End If
                End If
            Next J
        End If
    Next I
Next C
End Sub

Using your regex pattern equivalent instead for the Like operator, you can rewrite the above as below. Note that your Regex pattern will also match KKAR, and KRAK (as does the macro below, but not the one above).

Option Explicit
Sub boldSS()
    Dim WS As Worksheet
    Dim R As Range, C As Range
    Dim sPattern As String
    Dim I As Long

sPattern = "K[KR]?[KR]"

Set WS = Worksheets("sheet1")
With WS
    Set R = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With

For Each C In R
        With C.Font
            .Bold = False
            .Color = vbBlack
        End With
        If C Like "*" & sPattern & "*" Then
            For I = 1 To Len(C) - 4 + 1
                If Mid(C, I, 4) Like sPattern Then
                    With C.Characters(I, 4).Font
                        .Bold = True
                        .Color = vbRed
                    End With
                    If I < Len(C) - 3 Then
                        I = I + 3
                    Else
                        Exit For
                    End If
                End If
            Next I
        End If
Next C
End Sub
Sign up to request clarification or add additional context in comments.

Comments

0

SubString problems could be complicated, once one drills a bit in them. E.g., in the OP example, the substring KKYKDKSK also is a correct substring of KK*K, thus, it probably could be color coded as well.

In general, with some limitations the task, like searching for non-overlapping substrings and considering that the substring is present once per string, this is possible:

enter image description here

With some hardcoding of the variables and checking only for KK*K, this is how the main method looks like:

Option Explicit    
Sub TestMe()

    Dim myRange As Range: Set myRange = Worksheets(1).Range("A1:A2")

    Dim myCell As Range
    For Each myCell In myRange
        myCell.Font.Bold = False
        Dim subString As String
        subString = findTheSubString(myCell.Value2, "KK*K")
        Debug.Print myCell.text, subString
        ChangeTheFont subString, myCell, vbBlue
    Next myCell

End Sub

The function findTheSubString() takes the 2 strings and returns the substring, which is to be color-coded later:

Public Function findTheSubString(wholeString As String, subString As String) As String

    Dim regEx           As Object
    Dim inputMatches    As Object
    Dim regExString     As String

    Set regEx = CreateObject("VBScript.RegExp")

    With regEx
        .Pattern = Split(subString, "*")(0) & "[\s\S]*" & Split(subString, "*")(1)
        .IgnoreCase = True
        .Global = True

        Set inputMatches = .Execute(wholeString)
        If regEx.test(wholeString) Then
            findTheSubString = inputMatches(0)
        Else
            findTheSubString = "Not Found!"
        End If

    End With

End Function

The last part is to change the font of a specific substring in Excel range, thus the arguments are a string and a range:

Sub ChangeTheFont(lookFor As String, currentRange As Range, myColor As Long)

    Dim startPosition As Long: startPosition = InStr(1, currentRange.Value2, lookFor)
    Dim endPosition As Long: endPosition = startPosition + Len(currentRange.Value2)

    With currentRange.Characters(startPosition, Len(lookFor)).Font
        .Color = myColor
        .Bold = True
    End With
End Sub

2 Comments

Thanks. But I'm using Mac therefore `CreateObject("VBScript.RegExp") won't work.
@scamander - Welcome. I guess, there should be a way to refer to the regex object in Mac, although some links say it is not possible. If you find something that works, try to replace correspondingly. E.g. - stackoverflow.com/questions/27344932/…

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.