Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
More than Once
Hello from Steved
The below Formula is a Find And Replace I would like please for it to do several, for example open all files as it does now, then have it Find and Replace with some kind of loop until I have entered the last Find then Replace each time prompting if I have finished. 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 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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
More than Once
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 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 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 -- Regards, Tom Ogilvy "Steved" wrote in message ... Hello from Steved The below Formula is a Find And Replace I would like please for it to do several, for example open all files as it does now, then have it Find and Replace with some kind of loop until I have entered the last Find then Replace each time prompting if I have finished. 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 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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
More than Once
Thanks Tom you you're a gem
Cheers. -----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 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 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 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 -- Regards, Tom Ogilvy "Steved" wrote in message ... Hello from Steved The below Formula is a Find And Replace I would like please for it to do several, for example open all files as it does now, then have it Find and Replace with some kind of loop until I have entered the last Find then Replace each time prompting if I have finished. 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 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 . |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|