How to highlight substring using LIKE operator in Excel VBA - excel

Question

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:
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

Answer 1

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

Answer 2

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:
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