Input Box please

[Steved]

Hello From Steved
Every time I run the below program I have to edit my macro
each time.

Set FoundCell = Sh.Columns(1).Find( _
what:="2220")

So Please could the above be modified so that I can have
an input box to change the 2220 say to 4372

Thankyou.

Sub TesterAA1()
Dim FName As String
Dim FoundCell As Range
Dim WB As Workbook
Dim Sh As Worksheet
ChDrive "M:"
ChDir "M:\a-tt\a-work'g\mon-fri"
FName = Dir("*.xls")
Do Until FName = ""
Set WB = Workbooks.Open(FName)
For Each Sh In WB.Worksheets
Set FoundCell = Sh.Columns(1).Find( _
what:="2220")
If Not FoundCell Is Nothing Then
sAddr = FoundCell.Address
Do
Application.Goto Reference:=FoundCell, Scroll:=True
MsgBox "Take a look"
Set FoundCell = Sh.Columns(1) _
.FindNext(FoundCell)
Loop While Not FoundCell Is Nothing _
And FoundCell.Address <> sAddr
End If
Next
WB.Close Savechanges:=False
FName = Dir()
Loop
End Sub

 

[Norman Jones]

Hi Steve,

Try:

Sub TesterAA1()
Dim FName As String
Dim FoundCell As Range
Dim WB As Workbook
Dim Sh As Worksheet
Dim sAddr <==
Added
Dim MyFind As String <== Added

MyFind = InputBox("Enter search string") <== Added
ChDrive "M:"
ChDir "M:\a-tt\a-work'g\mon-fri"

FName = Dir("*.xls")
Do Until FName = ""
Set WB = Workbooks.Open(FName)
For Each Sh In WB.Worksheets
Set FoundCell = Sh.Columns(1).Find( _
what:=MyFind) <==
Amended
If Not FoundCell Is Nothing Then
sAddr = FoundCell.Address
Do
Application.Goto Reference:=FoundCell, _
Scroll:=True
MsgBox "Take a look"
Set FoundCell = Sh.Columns(1) _
.FindNext(FoundCell)
Loop While Not FoundCell Is Nothing _
And FoundCell.Address <> sAddr
End If
Next
WB.Close Savechanges:=False
FName = Dir()
Loop
End Sub

 

[Steved]

Hello Norman from Steved

Thankyou very much works as intended.

once again Thanks.

-----Original Message-----
Hi Steve,

Try:

Sub TesterAA1()
Dim FName As String
Dim FoundCell As Range
Dim WB As Workbook
Dim Sh As Worksheet
Dim sAddr
<==
Added
Dim MyFind As

String <== Added

MyFind = InputBox("Enter search

string") <== Added

ChDrive "M:"
ChDir "M:\a-tt\a-work'g\mon-fri"

FName = Dir("*.xls")
Do Until FName = ""
Set WB = Workbooks.Open(FName)
For Each Sh In WB.Worksheets
Set FoundCell = Sh.Columns(1).Find( _

what:=MyFind) <==