简体   繁体   中英

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

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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM