Start argument indicates the starting position of the text, Length is the length of text.

Macro 1 – Change partial text color using VBA Macro

This Macro aims to change the color of specific text in a Cell.

VBA Code

Public Sub ChgTxtColor()
Set myRange = Range("A1:A100") 'The Range that contains the substring you want to change color
substr = "delete" 'The text you want to change color
txtColor = 3 'The ColorIndex which repsents the color you want to change
For Each myString In myRange
lenstr = Len(myString)
lensubstr = Len(substr)
For i = 1 To lenstr
tempString = Mid(myString, i, lensubstr)
If tempString = substr Then
myString.Characters(Start:=i, Length:=lensubstr).Font.ColorIndex = txtColor
End If
Next i
Next myString
End Sub

Example

In the above Macro, I have defined to change all the text “delete” to red color in Range A1 to A100.

Macro 2 – Change text color inside brackets

This Macro aims to change text color that is enclosed by specific string. For example, (xxx) {xxxx}.

The starting string you declare (e.g. open bracket) must be different from ending string (close bracket), both starting string and ending string have to be one character.

VBA Code

I create two Arrays called stStrArr() and edStrArr(), which store the position of open bracket and close bracket respectively, open bracket has to be present before close bracket in order for the color change to happen.

Public Sub ChgTxtColor2()
Set myRange = Range("A1:A100") 'The Range that contains the substring you want to change color
stStr = "(" 'The first character of the substring you want to change color
edStr = ")" 'The last character of the substring you want to change color
txtColor = 3 'The ColorIndex which repsents the color you want to change, 3 represents Red
On Error Resume Next
For Each myString In myRange
Dim stStrArr(), edStrArr()
For i = 1 To Len(myString)
tempString = Mid(myString, i, 1)
If tempString = stStr Then
counter = counter + 1
ReDim Preserve stStrArr(counter)
stStrArr(counter) = i
End If
Next i
For j = 1 To Len(myString)
tempString2 = Mid(myString, j, 1)
If tempString2 = edStr Then
counter2 = counter2 + 1
ReDim Preserve edStrArr(counter2)
edStrArr(counter2) = j
End If
Next j
For k = 1 To counter
If edStrArr(k) > stStrArr(k) Then
myString.Characters(Start:=stStrArr(k), Length:=edStrArr(k) - stStrArr(k) + 1).Font.ColorIndex = txtColor
End If
Next k
Erase stStrArr()
Erase edStrArr()
Next myString
End Sub