Reputation: 31
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
Upvotes: 3
Views: 188
Reputation: 54948
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
Upvotes: 0
Reputation: 5902
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.
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:
And then fill in the value as appropriate:
Outcome will appear like this:
Upvotes: 1