CODEWITHSUNDEEP
excelvba
NewBe
NewBe

Reputation: 15

VBA to find cells with multiple words and change font color of one word to red

I need a VBA to find cells in Column H that have the word "only" and the word "Available" in the same cell and disregard all other occurences of "only". Then I want to turn the font color of "only" to red without changing the color of the other words in the cell.

Here is what I have so far. It finds all occurences of "only" but I don't know how to search for two words in the same cell.

Public Sub ChgTxtColor()
    Set myRange = Range("H1:H400")
    substr = "only"
    txtColor = 3
    
    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

Upvotes: 0

Views: 905

Answers (1)

Tim Williams
Tim Williams

Reputation: 166196

Try this:

Public Sub ChgTxtColor()
    Dim myRange As Range, txtColor As Long, c As Range, v
    
    Set myRange = Range("H1:H400")
    txtColor = vbRed

    For Each c In myRange.Cells       'loop each cell in range
        v = c.Value
        'If FindBoldText(c, "only") > 0 Then 'bolded text only
        If InStr(1, v, "only", vbTextCompare) > 0 Then
            'If FindBoldText(c, "available") > 0 Then 'bolded text only
            If InStr(1, v, "available", vbTextCompare) > 0 Then
                HilightAllInCell c, "only", txtColor
            End If
        End If
    Next c
End Sub

'Find the position of string `txt` in a cell `c` as long as it's bolded
'  Returns 0 if txt is not found or is present but not bolded
Function FindBoldText(c As Range, txt As String) As Long
    Dim pos As Long, rv As Long, bld, v
    v = c.Value
    bld = c.Font.Bold  'will be True, False, or Null (cell has mixed bold formatting)
    If bld = False Or Len(v) = 0 Then Exit Function 'no bold text or no content...
    pos = InStr(1, c.Value, txt, vbTextCompare)
    If pos > 0 Then
        If bld = True Then 'whole cell is bold?
            FindBoldText = pos
        ElseIf IsNull(bld) Then 'mixed bold formatting?
            If c.Characters(pos, Len(txt)).Font.Bold Then FindBoldText = pos
        End If
    End If
End Function

'hilight all instances of `findText` in range `c` using text color `hiliteColor`
Sub HilightAllInCell(c As Range, findText As String, hiliteColor As Long)
    Dim v, pos As Long
    v = c.Value
    If Len(v) > 0 Then     'any text to check?
        pos = 0            'set start position
        Do
            pos = InStr(pos + 1, v, findText, vbTextCompare) 'case-insensitive
            If pos > 0 Then  'found?
                'using Color instead of ColorIndex is more reproducible
                '  (since users can edit their color pallette)
                c.Characters(Start:=pos, Length:=Len(findText)).Font.Color = hiliteColor
            Else
                Exit Do    'not found, or no more matches
            End If
        Loop               'look again
    End If                 'anything to check
End Sub

Upvotes: 3

Related Questions