Only save and print if change made

[Kiba]

I have a code that searches and replaces. I want it only to save and print
if a change is made. Here's my code.

Sub ReplaceAndPrint()

' strFolder = "path to main folder"
strFolder = "C:\Documents and Settings\dwilson\Desktop\Correction"
Set fso = CreateObject _
("Scripting.FileSystemObject")
Set Folder = _
fso.GetFolder(strFolder)

Call ReplaceAndPrintSubFolder(strFolder + "\")
End Sub

Sub ReplaceAndPrintSubFolder(strFolder)
Set fso = CreateObject _
("Scripting.FileSystemObject")

Set Folder = _
fso.GetFolder(strFolder)

If Folder.subfolders.Count > 0 Then
For Each sf In Folder.subfolders
On Error GoTo 100
Call ReplaceAndPrintSubFolder(strFolder + sf.Name + "\")
100 Next sf
End If
'folder size in bytes
On Error GoTo 200
For Each fl In Folder.Files
Ext = fso.GetExtensionName(fl)
If UCase(Left(Ext, 2)) = "XL" Then

Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(fl)
On Error GoTo 0

If Not mybook Is Nothing Then

'Change cell value(s)
On Error Resume Next

'Experimental Coding

Application.DisplayAlerts = False
Application.ScreenUpdating = False

With mybook.Worksheets("Report")

Cells.Replace What:= _
"Place 2 labels per carton, 1 on front, and 1 on end.",
Replacement:= _
"Place a label on the end of each carton.", LookAt:=xlPart,
SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

Cells.Replace What:= _
"Place 2 labels per carton, 1 on front, and one on end.",
Replacement:= _
"Place a label on the end of each carton.", LookAt:=xlPart,
SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

Cells.Replace What:= _
"Place 2 labels per carton, one on front, and one on end.",
Replacement:= _
"Place a label on the end of each carton.", LookAt:=xlPart,
SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

Worksheets("Report").Select
Range("I2").Select

ActiveWindow.SelectedSheets.PrintOut Copies:=2, Collate:=True
End With

If Err.Number > 0 Then
ErrYes = True
Err.Clear
'close without saving
mybook.Close savechanges:=False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Else
mybook.Close savechanges:=True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End If
Else
ErrorYes = True
End If
End If
Next fl
200 On Error GoTo 0

End Sub




Sub ReplaceAndPrint()

' strFolder = "path to main folder"
strFolder = "C:\Documents and Settings\dwilson\Desktop\Correction"
Set fso = CreateObject _
("Scripting.FileSystemObject")
Set Folder = _
fso.GetFolder(strFolder)

Call ReplaceAndPrintSubFolder(strFolder + "\")
End Sub

Sub ReplaceAndPrintSubFolder(strFolder)
Set fso = CreateObject _
("Scripting.FileSystemObject")

Set Folder = _
fso.GetFolder(strFolder)

If Folder.subfolders.Count > 0 Then
For Each sf In Folder.subfolders
On Error GoTo 100
Call ReplaceAndPrintSubFolder(strFolder + sf.Name + "\")
100 Next sf
End If
'folder size in bytes
On Error GoTo 200
For Each fl In Folder.Files
Ext = fso.GetExtensionName(fl)
If UCase(Left(Ext, 2)) = "XL" Then

Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(fl)
On Error GoTo 0

If Not mybook Is Nothing Then

'Change cell value(s)
On Error Resume Next

'Experimental Coding

Application.DisplayAlerts = False
Application.ScreenUpdating = False

With mybook.Worksheets("Report")

Cells.Replace What:= _
"Place 2 labels per carton, 1 on front, and 1 on end.",
Replacement:= _
"Place a label on the end of each carton.", LookAt:=xlPart,
SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

Cells.Replace What:= _
"Place 2 labels per carton, 1 on front, and one on end.",
Replacement:= _
"Place a label on the end of each carton.", LookAt:=xlPart,
SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

Cells.Replace What:= _
"Place 2 labels per carton, one on front, and one on end.",
Replacement:= _
"Place a label on the end of each carton.", LookAt:=xlPart,
SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

Worksheets("Report").Select
Range("I2").Select

ActiveWindow.SelectedSheets.PrintOut Copies:=2, Collate:=True
End With

If Err.Number > 0 Then
ErrYes = True
Err.Clear
'close without saving
mybook.Close savechanges:=False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Else
mybook.Close savechanges:=True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End If
Else
ErrorYes = True
End If
End If
Next fl
200 On Error GoTo 0

End Sub




Thanks for the help

 

[Dave Peterson]

You could add some Find's that look for the old strings first. If any of those
are found, then do the replaces, then do the save and print.

 

[Kiba]

How would I go about doing that? Can you give me a few pointers or examples.
-Thanks

 

[Dave Peterson]

I'd put the strings to search for and replace into arrays and loop through
those.

Dim mySearchFors as variant
dim myReplaces as variant
dim FoundOne as boolean
dim iCtr as long
dim FoundCell as range

mysearchfors = array("qwer","qwerqwer","qwerqwerqwer")
myreplaces = array("asdf","asdfasdf","asdfasdfasdf")

if ubound(mysearches) <> ubound(myreplaces) then
msgbox "Design error!!!
exit sub
end if

foundone = false
for ictr = lbound(mysearchfors) to ubound(mysearchfors)
with somesheethere
set foundcell = .cells.find(what:=mysearchfors(ictr), ...
if foundcell is nothing then
'keep looking
else
foundone = true
exit for 'stop looking for more
end if
end with
next ictr

if foundone = false then
'nothing to replace, what should happen?
else
for ictr = lbound(mysearchfors) to ubound(mysearchfors)
with somesheethere
.cells.replace(what:=mysearchfors(ictr), _
replacement:=myreplaces(ictr), ...
end with
next ictr
'do the print and save
end if