S
Steved
Hello from Steved
The below was designed to do what it does
What the below does is open all file in a nominated
Directory. Once all opened it then has a message asking me
If MsgBox("OK to replace" & msg, vbYesNo) = vbYes.
What I would like please is when the first value is found
to replace then give me the message yes or no then move
on to find the next value to replace and so on.
Thankyou.
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
Dim ans As Variant
Dim bFirst As Boolean
ChDrive "C:"
ChDir "C:\Wtt"
FName = Dir("*.xls")
Do Until FName = ""
Set WB = Workbooks.Open(FName)
FName = Dir()
Loop
bFirst = True
Do While True
cnt = 0
If Not bFirst Then
ans = MsgBox("Go again", vbYesNo)
If ans = vbNo Then Exit Sub
End If
bFirst = False
ToReplace = Application.InputBox("What value to replace?")
ReplaceWith = Application.InputBox("Replace '" & _
ToReplace & "' with what other value?")
If ToReplace = "" Then Exit Do
For Each myBook In Application.Workbooks
If myBook.Name <> ThisWorkbook.Name Then
For Each mySht In myBook.Worksheets
msg = " in Book: " & myBook.Name & " Sheet: " & _
mySht.Name
If MsgBox("OK to replace" & msg, vbYesNo) = vbYes Then
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
End If
Next mySht
End If
Next myBook
MsgBox cnt & " sheets were changed"
Loop
For Each myBook In Application.Workbooks
If myBook.Name <> ThisWorkbook.Name Then
myBook.Close SaveChanges:=True
End If
Next
End Sub
The below was designed to do what it does
What the below does is open all file in a nominated
Directory. Once all opened it then has a message asking me
If MsgBox("OK to replace" & msg, vbYesNo) = vbYes.
What I would like please is when the first value is found
to replace then give me the message yes or no then move
on to find the next value to replace and so on.
Thankyou.
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
Dim ans As Variant
Dim bFirst As Boolean
ChDrive "C:"
ChDir "C:\Wtt"
FName = Dir("*.xls")
Do Until FName = ""
Set WB = Workbooks.Open(FName)
FName = Dir()
Loop
bFirst = True
Do While True
cnt = 0
If Not bFirst Then
ans = MsgBox("Go again", vbYesNo)
If ans = vbNo Then Exit Sub
End If
bFirst = False
ToReplace = Application.InputBox("What value to replace?")
ReplaceWith = Application.InputBox("Replace '" & _
ToReplace & "' with what other value?")
If ToReplace = "" Then Exit Do
For Each myBook In Application.Workbooks
If myBook.Name <> ThisWorkbook.Name Then
For Each mySht In myBook.Worksheets
msg = " in Book: " & myBook.Name & " Sheet: " & _
mySht.Name
If MsgBox("OK to replace" & msg, vbYesNo) = vbYes Then
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
End If
Next mySht
End If
Next myBook
MsgBox cnt & " sheets were changed"
Loop
For Each myBook In Application.Workbooks
If myBook.Name <> ThisWorkbook.Name Then
myBook.Close SaveChanges:=True
End If
Next
End Sub