Highlight Substring from an Array of Words

Question

This code is supposed to search from two textboxes on a User Form. It goes through each cell in a range, to check for the words from the textboxes and highlights them in red.

I cannot get the array to work.

Sub testing()
Worksheets("Search Results").Activate
Dim sPos As Long, sLen As Long
Dim SRrng As Range
Dim mywords As Variant
Dim i As Integer
Set SRrng = ActiveSheet.Range("A2:G1000")
mywords = Array(UsrFormTxtBox1, UserFormTextBox2)
For Each SRrng In SRrng
    With SRrng
        If SRrng.Value Like "*" & mywords & "*" Then
            If Not SRrng Is Nothing Then
                For i = 1 To Len(SRrng.Value)
                    sPos = InStr(i, SRrng.Value, mywords)
                    sLen = Len(mywords)
                    If (sPos <> 0) Then
                        SRrng.Characters(Start:=sPos, Length:=sLen).Font.Color = RGB(255, 0, 0)
                        SRrng.Characters(Start:=sPos, Length:=sLen).Font.Bold = True
                        i = sPos + Len(mywords) - 1
                    End If
                Next i
            End If
        End If
    End With
Next SRrng
End Sub

Answer 1

There were just two small issues - firstly your line:

For Each SRrng In SRrng

...you need to declare a second range variable to browse within the first range. I have called it cell (which is not a reserved word, unlike Cells):

For Each cell In SRrng

Secondly, your array stores two independent values which must be handled separately. I added a variable m and then used it to loop through the array contents. Full code:

Sub testing()
    Worksheets("Search Results").Activate
    Dim sPos As Long, sLen As Long
    Dim SRrng As Range, cell As Range
    Dim mywords As Variant
    Dim i As Integer
    Set SRrng = ActiveSheet.Range("A2:G1000")
    mywords = Array(UsrFormTxtBox1, UserFormTextBox2)
    Dim m As Byte
    For m = 0 To UBound(mywords)
        For Each cell In SRrng
            With cell
             If cell.Value Like "*" & mywords(m) & "*" Then
                If Not cell Is Nothing Then
                           For i = 1 To Len(cell.Value)
                           sPos = InStr(i, cell.Value, mywords(m))
                           sLen = Len(mywords(m))
                           If (sPos <> 0) Then
                            cell.Characters(Start:=sPos, Length:=sLen).Font.Color = RGB(255, 0, 0)
                            cell.Characters(Start:=sPos, Length:=sLen).Font.Bold = True
                            i = sPos + Len(mywords(m)) - 1
                           End If
                           Next i
               End If
            End If
            End With
        Next cell
    Next m
End Sub

By the way, your code is good but if your range became very large then it would be faster to use Find, like this:

Sub testing2()
    Worksheets("Search Results").Activate
    Dim sPos As Long, sLen As Long
    Dim SRrng As Range, cell As Range
    Dim mywords As Variant
    Dim i As Integer
    Set SRrng = ActiveSheet.Range("A2:G1000")
    mywords = Array(UsrFormTxtBox1, UserFormTextBox2)
    'mywords = Array("banana", "pear")
    Dim m As Byte
    Dim c As Range
    Dim firstAddress As String
    
    For m = 0 To UBound(mywords)
        With ActiveSheet.Range("A2:G1000")
            Set c = .Find(mywords(m), LookIn:=xlValues)
            If Not c Is Nothing Then
                firstAddress = c.Address
                Do
                    For i = 1 To Len(c.Value)
                        sPos = InStr(i, c.Value, mywords(m))
                        sLen = Len(mywords(m))
                        If (sPos <> 0) Then
                         c.Characters(Start:=sPos, Length:=sLen).Font.Color = RGB(255, 0, 0)
                         c.Characters(Start:=sPos, Length:=sLen).Font.Bold = True
                         i = sPos + Len(mywords(m)) - 1
                        End If
                    Next i
                
                    Set c = .FindNext(c)
                    If firstAddress = c.Address Then Exit Do
                Loop While Not c Is Nothing
            End If
        End With
    Next m
End Sub