Find value in Range, Sheet or Sheets with VBA (EXCEL)
Together with the Offset function you can also change cells around the found cell.
Below are a few basic examples that you can use to make your own code.
Use find to select a cell
Mark cells with the same value in column A in the B column
Color cells with the same value in a Range, worksheet or all worksheets
Copy cells to another sheet with Find
More Information
Use Find to select a cell
The examples below will search in column A of a sheet named "Sheet1"
for the inputbox value. Change the sheet name or range in the code to your sheet/range.
Tip: You can replace the inputbox with a string or a reference to a cell like this
FindString = "SearchWord"
Or
FindString = Sheets("Sheet1").Range("D1").Value
This will select the first cell in the range with the InputBox value.
Sub Find_First()
Dim FindString As String
Dim Rng As Range
FindString = InputBox("Enter a Search value")
If Trim(FindString) <> "" Then
With Sheets("Sheet1").Range("A:A")
Set Rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
Application.Goto Rng, True
Else
MsgBox "Nothing found"
End If
End With
End If
End Sub
If you have more then one occurrence of the value this will select the last occurrence.
Sub Find_Last()
Dim FindString As String
Dim Rng As Range
FindString = InputBox("Enter a Search value")
If Trim(FindString) <> "" Then
With Sheets("Sheet1").Range("A:A")
Set Rng = .Find(What:=FindString, _
After:=.Cells(1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False)
If Not Rng Is Nothing Then
Application.Goto Rng, True
Else
MsgBox "Nothing found"
End If
End With
End If
End Sub
If you have date's in column A then this example will select the cell with today's date.
Sub Find_Todays_Date()
Dim FindString As Date
Dim Rng As Range
FindString = CLng(Date)
With Sheets("Sheet1").Range("A:A")
Set Rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
Application.Goto Rng, True
Else
MsgBox "Nothing found"
End If
End With
End Sub
Mark cells with the same value in column A in the B column
This example search in Sheets("Sheet1") in column A for every cell
with "ron" and use Offset to mark the cell in the column to the right.
Note: you can add more values to the array MyArr.
Sub Mark_cells_in_column()
Dim FirstAddress As String
Dim MyArr As Variant
Dim Rng As Range
Dim I As Long
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Search for a Value Or Values in a range
'You can also use more values like this Array("ron", "dave")
MyArr = Array("ron")
'Search Column or range
With Sheets("Sheet1").Range("A:A")
'clear the cells in the column to the right
.Offset(0, 1).ClearContents
For I = LBound(MyArr) To UBound(MyArr)
'If you want to find a part of the rng.value then use xlPart
'if you use LookIn:=xlValues it will also work with a
'formula cell that evaluates to "ron"
Set Rng = .Find(What:=MyArr(I), _
After:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
FirstAddress = Rng.Address
Do
'mark the cell in the column to the right if "Ron" is found
Rng.Offset(0, 1).Value = "X"
Set Rng = .FindNext(Rng)
Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
End If
Next I
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Color cells with the same value in a Range, worksheet or all worksheets
This example color all cells in the range Sheets("Sheet1").Range("B1:D100") with "ron".
See the comments in the code if you want to use all cells on the worksheet.
I use the color index in this example to give all cells with "ron" the color 3 (normal this is red)
See this site for all the 56 index numbers
http://www.mvps.org/dmcritchie/excel/colors.htm
Tip: For changing the Font color see the example lines below the macros.
Sub Color_cells_In_Range_Or_Sheet()
Dim FirstAddress As String
Dim MySearch As Variant
Dim myColor As Variant
Dim Rng As Range
Dim I As Long
'Fill in the search Value and color Index
MySearch = Array("ron")
myColor = Array("3")
'You can also use more values in the Array
'MySearch = Array("ron", "jelle", "judith")
'myColor = Array("3", "6", "10")
'Fill in the Search range, for the whole sheet use
'you can use Sheets("Sheet1").Cells
With Sheets("Sheet1").Range("B1:D100")
'Change the fill color to "no fill" in all cells
.Interior.ColorIndex = xlColorIndexNone
For I = LBound(MySearch) To UBound(MySearch)
'If you want to find a part of the rng.value then use xlPart
'if you use LookIn:=xlValues it will also work with a
'formula cell that evaluates to MySearch(I)
Set Rng = .Find(What:=MySearch(I), _
After:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
FirstAddress = Rng.Address
Do
Rng.Interior.ColorIndex = myColor(I)
Set Rng = .FindNext(Rng)
Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
End If
Next I
End With
End Sub
Example for all worksheets in the workbook
Sub Color_cells_In_All_Sheets()
Dim FirstAddress As String
Dim MySearch As Variant
Dim myColor As Variant
Dim Rng As Range
Dim I As Long
Dim sh As Worksheet
'Fill in the search Value and color Index
MySearch = Array("ron")
myColor = Array("3")
'You can also use more values in the Array
'MySearch = Array("ron", "jelle", "judith")
'myColor = Array("3", "6", "10")
For Each sh In ActiveWorkbook.Worksheets
'Fill in the Search range, for a range on each sheet
'you can use sh.Range("B1:D100")
With sh.Cells
'Change the fill color to "no fill" in all cells
.Interior.ColorIndex = xlColorIndexNone
For I = LBound(MySearch) To UBound(MySearch)
'If you want to find a part of the rng.value then use xlPart
'if you use LookIn:=xlValues it will also work with a
'formula cell that evaluates to MySearch(I)
Set Rng = .Find(What:=MySearch(I), _
After:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
FirstAddress = Rng.Address
Do
Rng.Interior.ColorIndex = myColor(I)
Set Rng = .FindNext(Rng)
Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
End If
Next I
End With
Next sh
End Sub
Change the Font color instead of the Interior color
Replace:
'Change the fill color to "no fill" in all cells
.Interior.ColorIndex = xlColorIndexNone
With
'Change the font in the column to Automatic
.Font.ColorIndex = 0
And Replace:
Rng.Interior.ColorIndex = myColor(I)
With
Rng.Font.ColorIndex = myColor(I)
Copy cells to another sheet with Find
The example below will copy all cells with a E-Mail Address in the range
Sheets("Sheet1").Range("A1:E100") to a new worksheet in your workbook.
Note: I use xlPart in the code instead of xlWhole to find each cell with a @ character.
Sub Copy_To_Another_Sheet_1()
Dim FirstAddress As String
Dim MyArr As Variant
Dim Rng As Range
Dim Rcount As Long
Dim I As Long
Dim NewSh As Worksheet
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Fill in the search Value
MyArr = Array("@")
'You can also use more values in the Array
'myArr = Array("@", "www")
'Add new worksheet to your workbook to copy to
'You can also use a existing sheet like this
'Set NewSh = Sheets("Sheet2")
Set NewSh = Worksheets.Add
With Sheets("Sheet1").Range("A1:Z100")
Rcount = 0
For I = LBound(MyArr) To UBound(MyArr)
'If you use LookIn:=xlValues it will also work with a
'formula cell that evaluates to "@"
'Note : I use xlPart in this example and not xlWhole
Set Rng = .Find(What:=MyArr(I), _
After:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
FirstAddress = Rng.Address
Do
Rcount = Rcount + 1
Rng.Copy NewSh.Range("A" & Rcount)
' Use this if you only want to copy the value
' NewSh.Range("A" & Rcount).Value = Rng.Value
Set Rng = .FindNext(Rng)
Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
End If
Next I
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
More Information
If you only want to replace values in your worksheet then you can use Replace manual (Ctrl+h)
or use Replace in VBA. The code below replace ron for dave in the whole worksheet.
Change xlPart to xlWhole if you only want to replace cells with only ron.
ActiveSheet.Cells.Replace What:="ron", Replacement:="dave", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
Tip: Try this add-in named FlexFind from Jan Karel Pieterse.
http://www.jkp-ads.com/OfficeMarketPlaceFF-EN.asp
Chip Pearson
http://www.cpearson.com/excel/RangeFind.htm
No comments:
Post a Comment