Hi Rick -
Here are two versions. The first (FindHiLight) allows you to hard-code the
search key values into the VB Code. The second (FindHiLight_V2) allows you
to refer to a worksheet range for search key values.
Sub FindHiLight()
'Get search values from coded array
Dim MyFind As Variant
Dim MyNewValue As Variant
Dim FoundCell As Object
Dim Counter As Long
Dim searchList As Variant
'-------------------------------------------------
'- SET SEARCH KEY
searchList = Array("Rick'sString1", "Rick'sString2", _
"Rick'sString3", 783, "Rick'sString4", _
"Rick'sString5")
For Each MyFind In searchList
Counter = 0
'------------------------------------------------
'- FIND ALL MATCHING CELLS
On Error Resume Next
Set ws = ActiveSheet
Set FoundCell = ws.Cells.Find(what:=MyFind)
If Not FoundCell Is Nothing Then
FirstAddress = FoundCell.Address
Do
Counter = Counter + 1
'--------------------------------------------
'- what to do if found
FoundCell.Interior.ColorIndex = 6
'--------------------------------------------
Set FoundCell = ws.Cells.FindNext(FoundCell)
Loop While Not FoundCell Is Nothing _
And FoundCell.Address <> FirstAddress
End If
rsp = MsgBox("Searched For: " & MyFind & Chr(13) & Chr(13) & _
"Found: " & Counter)
Next 'MyFind
End Sub
Sub FindHiLight_V2()
'Get search values from worksheet range.
Dim MyFind As Variant
Dim MyNewValue As Variant
Dim FoundCell As Object
Dim Counter As Long
Dim searchList As Range
'-------------------------------------------------
'- SET SEARCH KEY
'===== Change Range in next statement as needed =======
Set searchList = Worksheets("Rick'sSheetName").Range("G1:G6")
For Each MyFind In searchList
Counter = 0
'------------------------------------------------
'- FIND ALL MATCHING CELLS
On Error Resume Next
Set ws = ActiveSheet
Set FoundCell = ws.Cells.Find(what:=MyFind)
If Not FoundCell Is Nothing Then
FirstAddress = FoundCell.Address
Do
Counter = Counter + 1
'--------------------------------------------
'- what to do if found
FoundCell.Interior.ColorIndex = 6
'--------------------------------------------
Set FoundCell = ws.Cells.FindNext(FoundCell)
Loop While Not FoundCell Is Nothing _
And FoundCell.Address <> FirstAddress
End If
rsp = MsgBox("Searched For: " & MyFind & Chr(13) & Chr(13) & _
"Found: " & Counter)
Next 'MyFind
End Sub
---
Jay
"Rick" wrote:
> I am using the Macro shown below to search of certain items then
> Highlight tham in Yellow.
> When I run the macro it prompts me for the data I am searching for
> them works perfectly.
> The items I am looking for are always the same. Is there some way to
> supply the names within the Macro rather than looping running the
> Macro, entering the item, rerunning the macro, enetering the next
> item...etc. It has been a very long time since I have done any
> programming and I just don't recall how to do this.
>
> Thanks in advance.
>
> Rick
> 6821065raa
>
>
>
>
> Sub FindHiLight()
> Dim MyFind As Variant
> Dim MyNewValue As Variant
> Dim FoundCell As Object
> Dim Counter As Long
> '-------------------------------------------------
> '- SET SEARCH KEY
> MyFind = InputBox("Please insert value to find.")
> If MyFind = "" Then End
> Counter = 0
> '------------------------------------------------
> '- FIND ALL MATCHING CELLS
> On Error Resume Next
> Set ws = ActiveSheet
> Set FoundCell = ws.Cells.Find(what:=MyFind)
> If Not FoundCell Is Nothing Then
> FirstAddress = FoundCell.Address
> Do
> Counter = Counter + 1
> '--------------------------------------------
> '- what to do if found
> FoundCell.Interior.ColorIndex = 6
> '--------------------------------------------
> Set FoundCell = ws.Cells.FindNext(FoundCell)
> Loop While Not FoundCell Is Nothing _
> And FoundCell.Address <> FirstAddress
> End If
> rsp = MsgBox("Found" & Counter)
> End Sub
>
>
|
Similar Threads
