Highlight a Searched for Word in VBA

Question

I want to have a code that will highlight every word that was searched for. I have a code already that kind of works, except for after line 30 it starts highlighting everything. I will add pictures for clarity. I don't know what it wrong with my code or what I could fix.

Here is my code.

Sub Highlight()
Application.ScreenUpdating = False
Dim Rng As Range
Dim cFnd As String
Dim xTmp As String
Dim x As Long
Dim m As Long
Dim y As Long
cFnd = ComboBox1.Value
y = Len(cFnd)
For Each Rng In Selection
  With Rng
    m = UBound(Split(Rng.Value, cFnd))
    If m > 0 Then
      xTmp = ""
      For x = 0 To m - 1
        xTmp = xTmp & Split(Rng.Value, cFnd)(x)
        .Characters(Start:=Len(xTmp) + 1, Length:=y).Font.ColorIndex = 3
        xTmp = xTmp & cFnd
      Next
    End If
  End With
Next Rng
Application.ScreenUpdating = True
End Sub

This is the search code to bring the search results to the page shown in the pictures.

Sub FindOne()

Range("B19:J5000") = ""

Application.ScreenUpdating = False

Dim k As Integer, EndPasteLoopa As Integer, searchColumn As Integer, searchAllCount As Integer
Dim myText As String
Dim totalValues As Long
Dim nextCell As Range
Dim searchAllCheck As Boolean

k = ThisWorkbook.Worksheets.Count
myText = ComboBox1.Value
Set nextCell = Range("B20")
If myText = "" Then
    MsgBox "No Address Found"
    Exit Sub
End If

Select Case ComboBox2.Value
    Case "SEARCH ALL"
        searchAllCheck = True
    Case "EQUIPMENT NUMBER"
        searchColumn = 1
    Case "EQUIPMENT DESCRIPTION"
        searchColumn = 3
    Case "DUPONT NUMBER"
        searchColumn = 6
    Case "SAP NUMBER"
        searchColumn = 7
    Case "SSI NUMBER"
        searchColumn = 8
    Case "PART DESCRIPTION"
        searchColumn = 9
    Case ""
        MsgBox "Please select a value for what you are searching by."
End Select

For I = 2 To k
    totalValues = Sheets(I).Cells(Rows.Count, "A").End(xlUp).Row
    ReDim AddressArray(totalValues) As String

    If searchAllCheck Then
        searchAllCount = 5
        searchColumn = 1
    Else
        searchAllCount = 0
    End If

    For qwerty = 0 To searchAllCount
        If searchAllCount Then
            Select Case qwerty
                Case "1"
                    searchColumn = 3
                Case "2"
                    searchColumn = 6
                Case "3"
                    searchColumn = 7
                Case "4"
                    searchColumn = 8
                Case "5"
                    searchColumn = 9
            End Select
        End If

        For j = 0 To totalValues
            AddressArray(j) = Sheets(I).Cells(j + 1, searchColumn).Value
        Next j

            For j = 0 To totalValues
            If InStr(1, AddressArray(j), myText) > 0 Then
                EndPasteLoop = 1
                If (Sheets(I).Cells(j + 2, searchColumn).Value = "") Then EndPasteLoop = Sheets(I).Cells(j + 1, searchColumn).End(xlDown).Row - j - 1
                For r = 1 To EndPasteLoop
                    Range(nextCell, nextCell.Offset(0, 8)).Value = Sheets(I).Range("A" & j + r, "I" & j + r).Value
                    Set nextCell = nextCell.Offset(1, 0)
                Next r
            End If
        Next j
    Next qwerty
Next
Application.ScreenUpdating = True
Range("A1").Select
End Sub

Thank you!

Answer 1

Well I feel really dumb. What I had worked originally. The reason I was getting the weird fills in other columns was because I wasn't clearing the text format whenever I would do a new search. When i changed that, it fixed everything.

Answer 2

Here is an approach that does what you want to do, but in a somewhat more direct way:

Sub HighlightCell(Rng As Range, cFnd As String)
    'highlights all nonoverlapping occurrences of cFnd in Rng (which is assumed to be a single cell)
    Dim s As String
    Dim i As Long, y As Long
    y = Len(cFnd)
    s = Rng.Value
    With Rng
        i = InStr(1, s, cFnd)
        Do While i > 0
          .Characters(Start:=i, Length:=y).Font.ColorIndex = 3
          i = InStr(i + y + 1, s, cFnd)
        Loop
    End With
End Sub

Sub Highlight()
    Application.ScreenUpdating = False
    Dim Rng As Range
    Dim cFnd As String

    cFnd = InputBox("Search for?") 'so I could test without setting up the combobox
    For Each Rng In Selection
        HighlightCell Rng, cFnd
    Next Rng
    Application.ScreenUpdating = True
End Sub

The following screenshot shows the result of running the code while A1:B2 is selected, where the search term is cat. Note that it is case sensitve:

Exactly why your sub was acting the way it was, I have no idea. Doubtless it has something to do with the way you were splitting on the string that you were searching for rather than finding it more directly.

You could look into using the Find method to locate the relevant cells even more efficiently, but the above code should fix the bug that you are encountering.