6

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
Jack BeNimble
  • 35,733
  • 41
  • 130
  • 213

7 Answers7

16

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.

html_programmer
  • 18,126
  • 18
  • 85
  • 158
6

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
datatoo
  • 2,019
  • 2
  • 21
  • 28
2

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. enter image description here

Cheers - Keep learning and applying. -WWC

  • Thanks for the code, you saved me. it works perfectly but when your column 1 not have same count of row with column 2, it higlights every single word. i was have 75 city name in column 1 and 3500 text in column 2, so when i realized it i copied and pasted my column 1 over and over again. thanks again. – t.ztrk Dec 07 '17 at 22:50
  • You are welcome, but you shouldn't have to copy it. Let me look at the code. - WWC – Wookies-Will-Code Dec 08 '17 at 15:02
  • Found the error, the first FOR loop should not reference col2 at all, sorry it was running the script against "" or an empty string in col1. This will work if the columns are not the same length, editing the answer for this line: **For i = Col1_rowSTART To Col1_rowEND** – Wookies-Will-Code Dec 08 '17 at 15:15
  • If you want to be able to find multiple occurrences of the city in the same line of text we will have to incorporate an approach from an answer above. – Wookies-Will-Code Dec 08 '17 at 15:23
1

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
Jack BeNimble
  • 35,733
  • 41
  • 130
  • 213
1

@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

0

A Functional Approach

To expand upon the answers already given, it would be more helpful to put this into a function so it is more flexible for any text.

In my approach I also wanted to have control on which instance of the text I wanted to highlight. So I provide a instance argument that can be:

  • 0 for highlight all matches
  • a positive number to look from the left
  • or a negative number to look from the right

Additionally, I thought it might be helpful to give the user an option of resetting the font to xlAutomatic before applying the new font color.

' This highlights certain text within a cell
' The instance can be 0 for all, specific index
' or even use negative indexing to search from
' the right side of the string.
' @author <robert@roberttodar.com>
Sub HighLightCellText( _
    target As Range, _
    text As String, _
    Optional instance As Long, _
    Optional color As Long = vbRed, _
    Optional resetCellBeforeHighlight As Boolean = False _
)
    ' Just in case the user wants a cell with no font
    ' coloring beforehand
    If resetCellBeforeHighlight Then
        target.Font.ColorIndex = xlAutomatic
    End If
    
    ' Get all the starting indexs of the text
    Dim indexes As Collection
    Set indexes = GetStartingIndexes(target.Value2, text)
    
    ' This allows the user to provide a negative index,
    ' meaning they can search from the right side of the
    ' text
    If instance < 0 Then
        instance = instance + (indexes.count + 1)
    End If
    
    Dim index As Long
    For index = 1 To indexes.count
        If index = instance Or instance = 0 Then
            ' This is the method for changing specific
            ' font of a cell.
            target.Characters( _
                start:=indexes.Item(index), _
                length:=Len(text) _
            ).Font.color = color
        End If
    Next
End Sub

This function above uses another helper function to find all the starting indexes of each instance of the found text.

' Helper function to get all the starting indexes of
' a specific text. This expands the `Instr` method
Public Function GetStartingIndexes( _
    ByVal text As String, _
    ByVal textToFind As String _
) As Collection
    Set GetStartingIndexes = New Collection
    
    Dim start As Long
    start = 1
    
    Do Until InStr(start, text, textToFind) = 0
        ' Find current iteration and add to collection
        start = InStr(start, text, textToFind)
        GetStartingIndexes.Add start

        ' Increment the start to after the last iteration
        start = start + Len(textToFind)
    Loop
End Function
Robert Todar
  • 2,085
  • 2
  • 11
  • 31
-2

You don't need VBA to do this. You can use Conditional Formatting.

Let's say you have a set of values in column E. You want to enter a value in cell B1 and highlight the cells in column E that match that value.

Highlight the cells in column E and apply the following conditional formatting:

highlight matching cells

Change the color(s) to suit. This will apply relative conditional formatting to the cells in column E. Ex: select E3 and view the conditional formatting, it should look like this:

relative reference

You can see how the formula adjusted itself.

(Edit: If you want to match the value in B1 to a substring of a value in column E, use this conditional formatting formula instead: =FIND($B$1,E1)>0)

Now type different values in cell B1. If you type a value that matches one of the values in column E, those cells (in column E) will change color. Change cell B1 to a value that does not exist in column E, the formatting disappears.

JimmyPena
  • 8,694
  • 6
  • 43
  • 64
  • Does this highlight the whole cell or just the text? I'm looking to highlight the text. – Jack BeNimble Jul 26 '12 at 18:09
  • 1
    This will highlight the whole cell. If you want to match on a substring, you need to use VBA. The `Worksheet_Change` Event with the code [Kim](http://stackoverflow.com/a/11672813/190829) posted. – JimmyPena Jul 26 '12 at 18:27