find and highlight exact numerical value

katana_flyer

New Member
Joined
Feb 19, 2020
Messages
17
Office Version
  1. 2013
Platform
  1. Windows
Hi everyone, been looking through other posts and have found similar, just can't seem to quite get it right.
I'm trying to find all cells containing a certain number, then highlighting them.
This code that I found on another post, nearly works but the problem I'm finding is if I enter "1" as the search number, it is finding all cells with 1 and also any number containing 1, such as 12, 13,110 etc.... Can anyone offer a modification to help sort it out?

(I'm a beginner so it may be an obvious answer to most)

Thank you

VBA Code:
Dim fnd As String, FirstFound As String
Dim FoundCell As Range, rng As Range
Dim myRange As Range, LastCell As Range

'What value do you want to find?
  fnd = InputBox("I want to hightlight cells with a value of ...", "Highlight")
  
    'End Macro if Cancel Button is Clicked or no Text is Entered
     If fnd = vbNullString Then Exit Sub

Set myRange = ActiveSheet.UsedRange
Set LastCell = myRange.Cells(myRange.Cells.Count)
Set FoundCell = myRange.Find(what:=fnd, 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 unique finds
  Do Until FoundCell Is Nothing
    'Find next cell with fnd 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 Found cells yellow
  rng.Interior.Color = RGB(255, 255, 0)

'Report Out Message
  MsgBox rng.Cells.Count & " cell(s) were found with value of : " & fnd

Exit Sub

'Error Handler
NothingFound:
  MsgBox "No cells containing: " & fnd & " were found in this worksheet"
 

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college

Forum statistics

Threads
1,214,911
Messages
6,122,196
Members
449,072
Latest member
DW Draft

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top