Highlight Substring from an Array of Words - arrays

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