Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.misc
|
|||
|
|||
Only save and print if change made
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 |
#2
Posted to microsoft.public.excel.misc
|
|||
|
|||
Only save and print if change made
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 wrote: 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 |
#3
Posted to microsoft.public.excel.misc
|
|||
|
|||
Only save and print if change made
How would I go about doing that? Can you give me a few pointers or examples.
-Thanks "Dave Peterson" wrote: 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 wrote: 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 |
#4
Posted to microsoft.public.excel.misc
|
|||
|
|||
Only save and print if change made
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 Kiba wrote: How would I go about doing that? Can you give me a few pointers or examples. -Thanks "Dave Peterson" wrote: 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 wrote: 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 -- Dave Peterson |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Save changes? even when you've made none | Excel Discussion (Misc queries) | |||
Do you want to save the changes you made to 'ABC.xls'? | Excel Discussion (Misc queries) | |||
save changes when no changes made | Excel Discussion (Misc queries) | |||
i made one spreadsheet but when i try to print two sheets print, | Excel Discussion (Misc queries) | |||
i made change in a current workbook and accidentally save it, can. | Excel Discussion (Misc queries) |