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

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


---
Regards,
Norman



"Steved" wrote in message
...
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

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) <==
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


---
Regards,
Norman



"Steved" wrote in
message
...
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





.