• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User


  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Add array to loop


this formula works -but I have multiple text words that need to be red in addition to "late".

How can I add more words?

Public Sub ChgTxtColor()
  Set myRange = Range("A25:A100")  'The Range that contains the substring you want to change color
  substr = "late"  '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


Last edited by a moderator:

Luke M

Excel Ninja
Let's make one sub that takes arguments, and then we can call it multiple times.

Public Sub MainCall()
    Application.ScreenUpdating = False
    'What are all the things to find?
    Call ChgTxtColor(Range("A25:A100"), "late", 3)
    Call ChgTxtColor(Range("A25:A100"), "start", 3)
    Call ChgTxtColor(Range("A25:A100"), "Chandoo", 3)
    Application.ScreenUpdating = True
End Sub
Private Sub ChgTxtColor(myRange As Range, subStr As String, txtColor As Long)
    Dim c As Range
    Dim myString As String
    Dim lenStr As Long
    Dim lenSubStr As Long
    Dim i As Long
    Dim xFound As Long
    Dim boolStatus As Boolean
    boolStatus = Application.ScreenUpdating
    Application.ScreenUpdating = False
    For Each c In myRange
        myString = c.Value
        lenStr = Len(myString)
        'Check for words, one after another
        If InStr(1, myString, subStr) Then
            'Where is the word
            xFound = InStr(1, myString, subStr)
            'How long is it?
            lenSubStr = Len(subStr)
            c.Characters(Start:=xFound, Length:=lenSubStr).Font.ColorIndex = txtColor
        End If
    Next c
    Application.ScreenUpdating = boolStatus
End Sub


I didn't think about this before- but what if I want a string of words and not just one word? I thought this would work for either but it's not