• 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

    Hui...

  • 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

jassybun

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

How can I add more words?



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

Attachments

  • Screen Shot 2018-12-20 at 13.32.42.png
    Screen Shot 2018-12-20 at 13.32.42.png
    12.6 KB · Views: 5
Last edited by a moderator:
Let's make one sub that takes arguments, and then we can call it multiple times.

Code:
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
 
Back
Top