Is this Possible

[Steved]

Hello from Steved.

I have 2 Macro's I would like to combine if possible.

The objective is for the macro to bring up the Input Box.
I will put in 2137 to find and replace with 7567.

Ok I can run the both macro's below and they work but
now I would like to goto the next step and combine the
both. If this is possible, this is what I would like to
happen, and that is open all files in the specified
directory in this case C:\Wtt, find each 2137 replace
with 7567 save and close file. At the end the message box
will then display how many times as it does now.

Thankyou.


Below opens and Closes all files in the selected Directory

Dim FName As String
Dim FoundCell As Range
Dim WB As Workbook
ChDrive "C:"
ChDir "C:\Wtt"
FName = Dir("*.xls")
Do Until FName = ""
Set WB = Workbooks.Open(FName)
WB.Close SaveChanges:=True ' or False
FName = Dir()
Loop
End Sub

The Below finds and replace and tells me in a message box
how many times.

Dim mySht As Worksheet
Dim myBook As Workbook
Dim ReplaceWith As String
Dim ToReplace As String
Dim cnt As Long, num As Long, num1 As Long

cnt = 0
ToReplace = Application.InputBox("What value to replace?")
ReplaceWith = Application.InputBox("Replace '" & _
ToReplace & "' with what other value?")

For Each myBook In Application.Workbooks
For Each mySht In myBook.Worksheets
num = Application.CountIf(mySht.UsedRange, ToReplace)
mySht.Cells.Replace _
ToReplace, ReplaceWith, _
xlWhole
num1 = Application.CountIf(mySht.UsedRange, ToReplace)
If num > 0 Then
cnt = cnt + 1
End If
If num1 <> 0 And num > 0 Then
MsgBox "Problems with " & mySht.Name
End If
Next mySht
Next myBook
MsgBox cnt & " sheets were changed"
End Sub

 

[Tom Ogilvy]

Sub ProcessBooks()
Dim FName As String
Dim FoundCell As Range
Dim WB As Workbook
Dim mySht As Worksheet
Dim myBook As Workbook
Dim ReplaceWith As String
Dim ToReplace As String
Dim cnt As Long, num As Long, num1 As Long

ChDrive "C:"
ChDir "C:\Wtt"
FName = Dir("*.xls")
Do Until FName = ""
Set WB = Workbooks.Open(FName)
FName = Dir()
Loop

cnt = 0
ToReplace = Application.InputBox("What value to replace?")
ReplaceWith = Application.InputBox("Replace '" & _
ToReplace & "' with what other value?")

For Each myBook In Application.Workbooks
if myBook.Name <> Thisworkbook.Name then
For Each mySht In myBook.Worksheets
num = Application.CountIf(mySht.UsedRange, ToReplace)
mySht.Cells.Replace _
ToReplace, ReplaceWith, _
xlWhole
num1 = Application.CountIf(mySht.UsedRange, ToReplace)
If num > 0 Then
cnt = cnt + 1
End If
If num1 <> 0 And num > 0 Then
MsgBox "Problems with " & mySht.Name
End If
Next mySht
myBook.Close SaveChanges:=True
End if
Next myBook
MsgBox cnt & " sheets were changed"
End Sub

 

[Steved]

Thanks very much Tom.

-----Original Message-----
Sub ProcessBooks()
Dim FName As String
Dim FoundCell As Range
Dim WB As Workbook
Dim mySht As Worksheet
Dim myBook As Workbook
Dim ReplaceWith As String
Dim ToReplace As String
Dim cnt As Long, num As Long, num1 As Long

ChDrive "C:"
ChDir "C:\Wtt"
FName = Dir("*.xls")
Do Until FName = ""
Set WB = Workbooks.Open(FName)
FName = Dir()
Loop

cnt = 0
ToReplace = Application.InputBox("What value to replace?")
ReplaceWith = Application.InputBox("Replace '" & _
ToReplace & "' with what other value?")

For Each myBook In Application.Workbooks
if myBook.Name <> Thisworkbook.Name then
For Each mySht In myBook.Worksheets
num = Application.CountIf(mySht.UsedRange, ToReplace)
mySht.Cells.Replace _
ToReplace, ReplaceWith, _
xlWhole
num1 = Application.CountIf(mySht.UsedRange, ToReplace)
If num > 0 Then
cnt = cnt + 1
End If
If num1 <> 0 And num > 0 Then
MsgBox "Problems with " & mySht.Name
End If
Next mySht
myBook.Close SaveChanges:=True
End if
Next myBook
MsgBox cnt & " sheets were changed"
End Sub



--
Regards,
Tom Ogilvy





.