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.