Find particular text, Select, and Highlight

user_16030067 0
Viewed 64

I want to find, and highlight cells that have a particular value.

In this example I'm searching for the number 2.

The code finds and highlights the cells with the number 2, but it also highlights cells with the number 22, and 23 because they contain the number 2.

'Find Search Values on Sheet and Highlight

Sub Find_And_Highlight()

Dim Searchfor As String
Dim FirstFound As String
Dim Lastcell As Range
Dim FoundCell As Range
Dim rng As Range
Dim myRange As Range

Set myRange = ActiveSheet.UsedRange
Set Lastcell = myRange.Cells(myRange.Cells.Count)
      
Searchfor = "2"
        
Set FoundCell = myRange.Find(what:=Searchfor, after:=Lastcell)
        
'Test to see if anything was found
If Not FoundCell Is Nothing Then
    FirstFound = FoundCell.Address
Else
    GoTo NothingFound
End If
         
Set rng = FoundCell
        
'Loop until cycled through all finds
Do Until FoundCell Is Nothing
    'Find next cell with Searchfor value
    Set FoundCell = myRange.FindNext(after:=FoundCell)
    'Add found cell to rng range variable
    Set rng = Union(rng, FoundCell)
    'Test to see if cycled through to first found cell
    If FoundCell.Address = FirstFound Then Exit Do
Loop
        
'Highlight cells that contain searchfor value
rng.Interior.ColorIndex = 34

Exit Sub

'Error Handler
NothingFound:
    MsgBox "No values were found in this worksheet"

End Sub
vba excel
2 Answers

Please look at the comment provided by @Craig which you need to implement. i.e. you need to modify the Foundcell line like below:

Set FoundCell = myRange.Find(what:=Searchfor, after:=Lastcell, lookat:=xlWhole)

Caution: This option modifies the user's search settings in Excel so in future make sure to uncheck below option in the Find box.

enter image description here

However, since you are changing the background color of the cells, you really do not need VBA for this purpose. You can use Conditional Formatting | Highlight Cells Rules | Equal To as shown below:

enter image description here

And then fill in the value as appropriate:

enter image description here

Outcome will appear like this:

enter image description here

user_87599270

Highlight Found Cells

  • Uncomment the Debug.Print lines in the FindAndHighlight procedure to better understand its behavior.
Option Explicit

Sub FindAndHighlight()

    ' You could use these constants ('ByVal') as arguments of this procedure,
    ' when you could call it with 'FindAndHighlight "2", 34' from yet another
    ' procedure.
    Const SearchString As String = "2"
    Const cIndex As Long = 34
    
    If ActiveSheet Is Nothing Then Exit Sub ' if run from add-in
    If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub ' if e.g. chart
    'Debug.Print "Worksheet Name:       " & ActiveSheet.Name
    
    Dim srg As Range: Set srg = ActiveSheet.UsedRange
    'Debug.Print "Source Range Address: " & srg.Address(0, 0)
    
    Dim frg As Range: Set frg = refFindStringInRange(srg, SearchString)
    If frg Is Nothing Then
        MsgBox "No occurrence of '" & SearchString & "' found in range '" _
            & srg.Address(0, 0) & "' of worksheet '" & srg.Worksheet.Name _
            & "'.", vbCritical, "Nothing Found"
        Exit Sub
    End If
    'Debug.Print "Found Range Address:  " & frg.Address(0, 0)
    
    HighLightRangeUsingColorIndex frg, cIndex

End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Creates a reference to a range combined of all cells
'               whose contents are equal to a string.
' Remarks:      The search is case-insensitive ('MatchCase') and is performed
'               by rows ('SearchOrder') ascending ('SearchDirection',
'               ('FindNext')), starting with the first cell ('After')
'               of each area of the range.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function refFindStringInRange( _
    ByVal SearchRange As Range, _
    ByVal SearchString As String) _
As Range

    If SearchRange Is Nothing Then Exit Function
    
    Dim frg As Range
    Dim arg As Range
    Dim lCell As Range
    Dim fCell As Range
    Dim FirstAddress As String
    
    For Each arg In SearchRange.Areas
        Set lCell = arg.Cells(arg.Rows.Count, arg.Columns.Count)
        Set fCell = Nothing
        ' By modifying the parameters of the arguments of the 'Find' method
        ' you can change the behavior of the function in many ways.
        Set fCell = arg.Find(SearchString, lCell, xlFormulas, xlWhole, xlByRows)
        If Not fCell Is Nothing Then
            FirstAddress = fCell.Address
            Do
                If frg Is Nothing Then
                    Set frg = fCell
                Else
                    Set frg = Union(frg, fCell)
                End If
                Set fCell = arg.FindNext(After:=fCell)
            Loop Until fCell.Address = FirstAddress
        End If
    Next arg
      
    If Not frg Is Nothing Then
        Set refFindStringInRange = frg
    End If
    
End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Highlights the cells of a range using a color index.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub HighLightRangeUsingColorIndex( _
        ByVal rg As Range, _
        ByVal cIndex As Long)
    If rg Is Nothing Then Exit Sub
    If cIndex < 1 Or cIndex > 56 Then Exit Sub
    rg.Interior.ColorIndex = cIndex
End Sub
user_98140690
Related