How to highlight selected text within excel

Question

I would like to write a VBA function to highlight specific text within an excel cell. Is this possible? I've been googling but it's unclear at this point.

to clarify, I would like to search a specific column for a text value (actually a list of values) and highlight the matched text in say yellow.

Note: this is what I ended up doing:

  Sub Colors()


    Dim searchString As String
    Dim targetString As String
    Dim startPos As Integer

    searchString = "abc"
    targetString = Cells(2, 1).Value
    startPos = InStr(targetString, searchString)

    If startPos > 0 Then

        Cells(2, 1).Characters(startPos, Len(searchString)).Font.Color = vbRed

    End If


 End Sub

Solution 1

This is the basic principle, I assume that customizing this code is not what you are asking (as no details about this were provided):

 Sub Colors()

 With Range("A1")
    .Value = "Test"
    .Characters(2, 2).Font.Color = vbGreen
 End With

 End Sub

Small description although it speaks quite for itself: the first "2" refers to the first character that needs to be colored, the second "2" refers to the length.

Solution 2

This is only for future readers trying to highlight a specific string pattern inside of cells,

(which is how I had interpreted the question) You can set the string being searched for in F1 in this example

Sub test4String2color()
Dim strTest As String
Dim strLen As Integer
 strTest = Range("F1")
 strLen = Len(strTest)
For Each cell In Range("A1:D100")
 If InStr(cell, strTest) > 0 Then
  cell.Characters(InStr(cell, strTest), strLen).Font.Color = vbRed
 End If
Next
End Sub

Solution 3

This is answer is specifically for @t.ztrk who has cities in Col1 and text to search for those cities in column 2. He posted his question over here: is it possible to find and change color of the text in excel

I borrowed from this code from another solution (sorry if it was not the original):https://stackoverflow.com/a/11676031/8716187

Sub test4String2color()
Dim strTest As String
Dim strLen As Integer
 strTest = Range("F1")
 strLen = Len(strTest)
For Each cell In Range("A1:D100")
 If InStr(cell, strTest) > 0 Then
  cell.Characters(InStr(cell, strTest), strLen).Font.Color = vbRed
 End If
Next
End Sub

I know this might not be elegant but I punched it out in a few minutes to meet the users need. Sorry in advance if the solutions provided above are (1) more flexible or (2) more efficient. Also sorry for my C++ nested loop habits coming through.

@t.ztrk you can record a macro and just stop it (delete whatever is there) or insert a button control and paste the code there. Not sure what your VB familiarity is. Just be sure to select a cell on the worksheet you want to process before you run the macro (it should run on any sheet and can be made to work on any workbook).

Sub Macro1()
'Searches all text in Column 2 on a Sheet for the string located in Column 1
'If found it highlights that text
Dim ThisWB As Workbook
Dim ThisWS As Worksheet
Dim i As Integer
Dim y As Integer

Dim Col1 As Double
Dim Col2 As Double

Dim Col1_rowSTART As Double
Dim Col1_rowEND As Double

Dim Col2_rowSTART As Double
Dim Col2_rowEND As Double

Dim strTest As String
Dim strLen As Integer

'Set up parameter that we know
Set ThisWB = ActiveWorkbook
Set ThisWS = ActiveSheet
Col1 = 1 'city column
Col2 = 2 'text search column
'Define Starting Row for each column
Col1_rowSTART = 1
Col2_rowSTART = 1
'Define ending row for each column
Col1_rowEND = ThisWS.Cells(ThisWS.Rows.Count, Col1).End(xlUp).Row
Col2_rowEND = ThisWS.Cells(ThisWS.Rows.Count, Col2).End(xlUp).Row

'Could be fancy and see which column is shorter ....
'Won't do that here

For i = Col1_rowSTART To Col1_rowEND
    'make a string out of each cell value in Col1
    strTest = CStr(ThisWS.Cells(i, Col1))
    strLen = Len(strTest)
    'Roll thorugh all of Column 2 in search of the target string
    For y = Col2_rowSTART To Col2_rowEND
        'Check if Col1 string is in Col2 String
        If InStr(CStr(ThisWS.Cells(y, Col2)), strTest) > 0 Then
            ThisWS.Cells(y, Col2).Characters(InStr(ThisWS.Cells(y, Col2), strTest), strLen).Font.Color = vbRed
        End If
    Next y
Next i

MsgBox ("City Search Complete!")

End Sub

Here is your testing screenshot.

Cheers - Keep learning and applying. -WWC

Solution 4

One problem with highlighting text in a cell is that there could be more than one occurrence of the string, so the code should really check to see if there are any more. Here's my solution to that problem:

Sub Colors()


    Dim searchTerms As Variant


    searchTerms = Array("searchterm1", "searchterm2",  "lastsearchterm")


    Dim searchString As String
    Dim targetString As String
    Dim offSet As Integer
    Dim colToSearch As Integer
    Dim arrayPos, rowNum As Integer

    colToSearch = 3


    For arrayPos = LBound(searchTerms) To UBound(searchTerms)
        For rowNum = 2 To 31124

            searchString = Trim(searchTerms(arrayPos))

            offSet = 1

            Dim x As Integer

            targetString = Cells(rowNum, colToSearch).Value

            x = HilightString(offSet, searchString, rowNum, colToSearc)

        Next rowNum
    Next arrayPos

 End Sub

Function HilightString(offSet As Integer, searchString As String, rowNum As Integer, ingredCol As Integer) As Integer

            Dim x As Integer
            Dim newOffset As Integer
            Dim targetString As String


            ' offet starts at 1

            targetString = Mid(Cells(rowNum, ingredCol), offSet)

            foundPos = InStr(LCase(targetString), searchString)

            If foundPos > 0 Then

                ' the found position will cause a highlight where it was found in the cell starting at the offset - 1
                Cells(rowNum, ingredCol).Characters(offSet + foundPos - 1, Len(searchString)).Font.Color = vbRed

                ' increment the offset to found position + 1 + the length of the search string
                newOffset = offSet + foundPos + Len(searchString)

                x = HilightString(newOffset, searchString, rowNum, ingredCol)
            Else
                ' if it's not found, come back out of the recursive call stack
                Exit Function
            End If
End Function

Solution 5

@Jack BeNimble thanks for the code, used it successfully in 10 mins to highlight all the numbers in a cell. I reorganized it a tad, searching all search terms within a row and cell first and allowed for multiple columns. I found one error, your highlight text didn't like repeats 55, 444, only highlighted the odd repeats in a sequence. Modified one line in Highlight Function

newOffset = offSet + foundPos + Len(searchString) - 1 //added the - 1.

here is my modified code.

Sub NumberColors()

Dim searchTerms As Variant


searchTerms = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", ".")


Dim searchString As String
Dim targetString As String
Dim offSet As Integer
Dim colsToSearch As Variant
Dim arrayPos, colIndex, colNum As Integer
Dim rowNum As Integer

colsToSearch = Array(4, 44, 45)


For colIndex = LBound(colsToSearch) To UBound(colsToSearch)
    colNum = colsToSearch(colIndex)
    For rowNum = 5 To 3000
        For arrayPos = LBound(searchTerms) To UBound(searchTerms)
            searchString = Trim(searchTerms(arrayPos))

            offSet = 1

            Dim x As Integer

            targetString = Cells(rowNum, colNum).Value

            x = HilightString(offSet, searchString, rowNum, colNum)
        Next arrayPos
    Next rowNum
Next colIndex

End Sub

Function HilightString(offSet As Integer, searchString As String, rowNum As Integer, ingredCol As Integer) As Integer

        Dim x As Integer
        Dim newOffset As Integer
        Dim targetString As String


        ' offet starts at 1

        targetString = Mid(Cells(rowNum, ingredCol), offSet)

        foundPos = InStr(LCase(targetString), searchString)

        If foundPos > 0 Then

            ' the found position will cause a highlight where it was found in the cell starting at the offset - 1
            Cells(rowNum, ingredCol).Characters(offSet + foundPos - 1, Len(searchString)).Font.Color = vbBlue

            ' increment the offset to found position + 1 + the length of the search string
            newOffset = offSet + foundPos + Len(searchString) - 1

            x = HilightString(newOffset, searchString, rowNum, ingredCol)
        Else
            ' if it's not found, come back out of the recursive call stack
            Exit Function
        End If

End Function

Thanks Jack BeNimbleand datatoo

View more solutions