Autofilling INPUTBOX

[Rick]

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

 

[Jay]

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

 

[Mike H]

Rick,

Create a list (I've used Col A sheet 2) and this will read that list for up
to 1000 search items.

Sub FindHiLight()
Dim MyFind As Variant
Dim MyNewValue As Variant
Dim FoundCell As Object
Dim Counter As Long
'-------------------------------------------------
'- SET SEARCH KEY

For x = 1 To 1000
MyFind = Worksheets("sheet2").Cells(x, 1).Value
'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 & " " & MyFind)
Next
End Sub