![]() |
unwanted copy
I am trying to finalise my archive procedure and am facing two problems that I would greatly appreciate a hand with. Currently the procedure creates an archive of a master file and and gives the user an option to not proceed if a file with the same name already exists (msg box). However if the do not proceed option is taken (NO) then I am left with the copied and unnamed file open. How can I get rid of this unwanted copy and navigate back to a specified sheet. Thanks in advance for any input. ' creates archive copy of stage clearance master data in specified location Sub CreateArchive() Dim Wb As Workbook Dim ws As Worksheet Dim sStr As String Dim Res As Long Dim ws1 As Worksheet Dim ws2 As Worksheet Dim ws3 As Worksheet Dim ws4 As Worksheet Application.ScreenUpdating = False Set Wb = Workbooks("Single Sheet.xls")relabeled Set ws = Worksheets("Master") Set ws1 = Worksheets("stageclearer 1") Set ws2 = Worksheets("stageclearer 2") Set ws3 = Worksheets("stageclearer 3") Set ws4 = Worksheets("stageclearer 4") sStr = Format(Date, "yymmdd") & " " & "Stage Clearer" ws.Copy ws1.UsedRange.Offset(1).Clear ws2.UsedRange.Offset(1).Clear ws3.UsedRange.Offset(1).Clear ws4.UsedRange.Offset(1).Clear ws.UsedRange.Offset(1).Clear If file_exist("G:\" & sStr & ".xls") Res = MsgBox("This file already Exists. " & _ "Do you want to overwrite it?", vbYesNo + vbCritical, "OVERWRITE FILE") If Res = vbYes Then Application.DisplayAlerts = False ActiveWorkbook.SaveAs "G:\" & sStr ActiveWorkbook.Close Application.DisplayAlerts = True End If Else ActiveWorkbook.SaveAs "G:\" & sStr Worksheets("Navigation").Select End If Application.ScreenUpdating = True End Sub Function file_exist(str As String) If Len(Dir(str)) 0 Then file_exist = True Else file_exist = False End If End Function -- Kstalker ------------------------------------------------------------------------ Kstalker's Profile: http://www.excelforum.com/member.php...o&userid=24699 View this thread: http://www.excelforum.com/showthread...hreadid=385437 |
unwanted copy
This code closes the activeworkbook without saving it (In Excel 2000)
ActiveWorkbook.Saved = True ActiveWorkbook.Close build an if statement to turn it loose... -- steveB Remove "AYN" from email to respond "Kstalker" wrote in message ... I am trying to finalise my archive procedure and am facing two problems that I would greatly appreciate a hand with. Currently the procedure creates an archive of a master file and and gives the user an option to not proceed if a file with the same name already exists (msg box). However if the do not proceed option is taken (NO) then I am left with the copied and unnamed file open. How can I get rid of this unwanted copy and navigate back to a specified sheet. Thanks in advance for any input. ' creates archive copy of stage clearance master data in specified location Sub CreateArchive() Dim Wb As Workbook Dim ws As Worksheet Dim sStr As String Dim Res As Long Dim ws1 As Worksheet Dim ws2 As Worksheet Dim ws3 As Worksheet Dim ws4 As Worksheet Application.ScreenUpdating = False Set Wb = Workbooks("Single Sheet.xls")relabeled Set ws = Worksheets("Master") Set ws1 = Worksheets("stageclearer 1") Set ws2 = Worksheets("stageclearer 2") Set ws3 = Worksheets("stageclearer 3") Set ws4 = Worksheets("stageclearer 4") sStr = Format(Date, "yymmdd") & " " & "Stage Clearer" ws.Copy ws1.UsedRange.Offset(1).Clear ws2.UsedRange.Offset(1).Clear ws3.UsedRange.Offset(1).Clear ws4.UsedRange.Offset(1).Clear ws.UsedRange.Offset(1).Clear If file_exist("G:\" & sStr & ".xls") Res = MsgBox("This file already Exists. " & _ "Do you want to overwrite it?", vbYesNo + vbCritical, "OVERWRITE FILE") If Res = vbYes Then Application.DisplayAlerts = False ActiveWorkbook.SaveAs "G:\" & sStr ActiveWorkbook.Close Application.DisplayAlerts = True End If Else ActiveWorkbook.SaveAs "G:\" & sStr Worksheets("Navigation").Select End If Application.ScreenUpdating = True End Sub Function file_exist(str As String) If Len(Dir(str)) 0 Then file_exist = True Else file_exist = False End If End Function -- Kstalker ------------------------------------------------------------------------ Kstalker's Profile: http://www.excelforum.com/member.php...o&userid=24699 View this thread: http://www.excelforum.com/showthread...hreadid=385437 |
unwanted copy
Hi Kristan,
How can I get rid of this unwanted copy and navigate back to a specified sheet. Move the line: ws.Copy to a postion immediately after the line: If Res = vbYes Then That way you only create the copy if it is needed. BTW, the line: If file_exist("G:\" & sStr & ".xls") should be: If file_exist("G:\" & sStr & ".xls") Then --- Regards, Norman "Kstalker" wrote in message ... I am trying to finalise my archive procedure and am facing two problems that I would greatly appreciate a hand with. Currently the procedure creates an archive of a master file and and gives the user an option to not proceed if a file with the same name already exists (msg box). However if the do not proceed option is taken (NO) then I am left with the copied and unnamed file open. How can I get rid of this unwanted copy and navigate back to a specified sheet. Thanks in advance for any input. ' creates archive copy of stage clearance master data in specified location Sub CreateArchive() Dim Wb As Workbook Dim ws As Worksheet Dim sStr As String Dim Res As Long Dim ws1 As Worksheet Dim ws2 As Worksheet Dim ws3 As Worksheet Dim ws4 As Worksheet Application.ScreenUpdating = False Set Wb = Workbooks("Single Sheet.xls")relabeled Set ws = Worksheets("Master") Set ws1 = Worksheets("stageclearer 1") Set ws2 = Worksheets("stageclearer 2") Set ws3 = Worksheets("stageclearer 3") Set ws4 = Worksheets("stageclearer 4") sStr = Format(Date, "yymmdd") & " " & "Stage Clearer" ws.Copy ws1.UsedRange.Offset(1).Clear ws2.UsedRange.Offset(1).Clear ws3.UsedRange.Offset(1).Clear ws4.UsedRange.Offset(1).Clear ws.UsedRange.Offset(1).Clear If file_exist("G:\" & sStr & ".xls") Res = MsgBox("This file already Exists. " & _ "Do you want to overwrite it?", vbYesNo + vbCritical, "OVERWRITE FILE") If Res = vbYes Then Application.DisplayAlerts = False ActiveWorkbook.SaveAs "G:\" & sStr ActiveWorkbook.Close Application.DisplayAlerts = True End If Else ActiveWorkbook.SaveAs "G:\" & sStr Worksheets("Navigation").Select End If Application.ScreenUpdating = True End Sub Function file_exist(str As String) If Len(Dir(str)) 0 Then file_exist = True Else file_exist = False End If End Function -- Kstalker ------------------------------------------------------------------------ Kstalker's Profile: http://www.excelforum.com/member.php...o&userid=24699 View this thread: http://www.excelforum.com/showthread...hreadid=385437 |
unwanted copy
Thanks Steve / Norman Was not completely clear. I need to discard the worksheet that was decided not to copied. Keep the workbook that it is being archived from open and navigate back to a sheet within it when overwrite existing file is declined. Any ideas? Kristan -- Kstalker ------------------------------------------------------------------------ Kstalker's Profile: http://www.excelforum.com/member.php...o&userid=24699 View this thread: http://www.excelforum.com/showthread...hreadid=385437 |
unwanted copy
Hi Kristan
"Kstalker" wrote in message ... Thanks Steve / Norman Was not completely clear. I need to discard the worksheet that was decided not to copied. Keep the workbook that it is being archived from open and navigate back to a sheet within it when overwrite existing file is declined. Any ideas? Kristan Did my suggestion not do exactly this? The point of my suggestion is that the worksheet is not created if not needed and, hence, no deletion is required. Incidentally, it is not a worksheet, but a single-sheet workbook. --- Regards, Norman |
unwanted copy
Hi Norman. On the initial archive request when there is no pre-existing file with same name and yes is selected to create archive workbook it actually creates an entire copy of the 'Single Sheet' workbook as opposed to a specific worksheet within the book. It becomes the open workbook and closes "Single Sheet". What do you think? I am at a loss. Kristan -- Kstalker ------------------------------------------------------------------------ Kstalker's Profile: http://www.excelforum.com/member.php...o&userid=24699 View this thread: http://www.excelforum.com/showthread...hreadid=385437 |
unwanted copy
Hi Kristan,
Before responding to your comments, please confirm *which* worksheet in the SingleSheet.XLS workbook you want to archive. It is only one? --- Regards, Norman "Kstalker" wrote in message ... Hi Norman. On the initial archive request when there is no pre-existing file with same name and yes is selected to create archive workbook it actually creates an entire copy of the 'Single Sheet' workbook as opposed to a specific worksheet within the book. It becomes the open workbook and closes "Single Sheet". What do you think? I am at a loss. Kristan -- Kstalker ------------------------------------------------------------------------ Kstalker's Profile: http://www.excelforum.com/member.php...o&userid=24699 View this thread: http://www.excelforum.com/showthread...hreadid=385437 |
unwanted copy
Hi Norman. I am trying to archive the "master" worksheet only. And then onc archived clear the used content of it and the stage clearance sheets. thanks Krista -- Kstalke ----------------------------------------------------------------------- Kstalker's Profile: http://www.excelforum.com/member.php...fo&userid=2469 View this thread: http://www.excelforum.com/showthread.php?threadid=38543 |
unwanted copy
Hi Kristan,
Try: Sub CreateArchive() Dim Wb As Workbook Dim ws As Worksheet Dim ws1 As Worksheet Dim ws2 As Worksheet Dim ws3 As Worksheet Dim ws4 As Worksheet Dim sStr As String Dim Res As Long Application.ScreenUpdating = False On Error GoTo XIT Set Wb = Workbooks("Single Sheet.xls") 'relabeled With Wb Set ws = .Worksheets("Master") Set ws1 = .Worksheets("stageclearer 1") Set ws2 = .Worksheets("stageclearer 2") Set ws3 = .Worksheets("stageclearer 3") Set ws4 = .Worksheets("stageclearer 4") End With sStr = Format(Date, "yymmdd") & " " & "Stage Clearer" ws1.UsedRange.Offset(1).Clear ws2.UsedRange.Offset(1).Clear ws3.UsedRange.Offset(1).Clear ws4.UsedRange.Offset(1).Clear ws.UsedRange.Offset(1).Clear If file_exist("C:\" & sStr & ".xls") Then Res = MsgBox("This file already Exists. " _ & " Do you want to overwrite it?", _ vbYesNo + vbCritical, "OVERWRITE FILE ") If Res = vbYes Then ws.Copy Application.DisplayAlerts = False ActiveWorkbook.SaveAs "C:\" & sStr ActiveWorkbook.Close Application.DisplayAlerts = True End If Else ws.Copy ActiveWorkbook.SaveAs "C:\" & sStr ActiveWorkbook.Close End If Wb.Activate Wb.Worksheets("Navigation").Select XIT: With Application .ScreenUpdating = True .DisplayAlerts = True End With End Sub --- Regards, Norman "Kstalker" wrote in message ... Hi Norman. I am trying to archive the "master" worksheet only. And then once archived clear the used content of it and the stage clearance sheets. thanks Kristan -- Kstalker ------------------------------------------------------------------------ Kstalker's Profile: http://www.excelforum.com/member.php...o&userid=24699 View this thread: http://www.excelforum.com/showthread...hreadid=385437 |
unwanted copy
Legendary. Thanks for all your help on that Norman. Regards Kristan -- Kstalker ------------------------------------------------------------------------ Kstalker's Profile: http://www.excelforum.com/member.php...o&userid=24699 View this thread: http://www.excelforum.com/showthread...hreadid=385437 |
unwanted copy
Norman. Just when I thought I was on the home stretch. I am now getting a Compile Error; Sub or Function not defined. Highlighting the If file_exist("G:) part of the sub. I have shifted the clear content from youir original post but this should not be causing a problem. If you have a chance could you point out what I have done. Thanks again.. Kristan Option Explicit Sub CreateArchive() Dim Wb As Workbook Dim ws As Worksheet Dim ws1 As Worksheet Dim ws2 As Worksheet Dim ws3 As Worksheet Dim ws4 As Worksheet Dim sStr As String Dim Res As Long Application.ScreenUpdating = False On Error GoTo XIT Set Wb = Workbooks("Single Sheet.xls") With Wb Set ws = .Worksheets("Master") Set ws1 = .Worksheets("stageclearer 1") Set ws2 = .Worksheets("stageclearer 2") Set ws3 = .Worksheets("stageclearer 3") Set ws4 = .Worksheets("stageclearer 4") End With sStr = Format(Date, "yymmdd") & " " & "Stage Clearer" If file_exist("G:\" & sStr & ".xls") Then '<<===== CHANGE if worksheet shifted Res = MsgBox("This file already Exists. " _ & " Do you want to overwrite it?", _ vbYesNo + vbCritical, "OVERWRITE FILE ") If Res = vbYes Then ws.Copy ws1.UsedRange.Offset(1).Clear ws2.UsedRange.Offset(1).Clear ws3.UsedRange.Offset(1).Clear ws4.UsedRange.Offset(1).Clear ws.UsedRange.Offset(1).Clear Application.DisplayAlerts = False ActiveWorkbook.SaveAs "G:\" & sStr ActiveWorkbook.Close Application.DisplayAlerts = True End If Else ws.Copy ws1.UsedRange.Offset(1).Clear ws2.UsedRange.Offset(1).Clear ws3.UsedRange.Offset(1).Clear ws4.UsedRange.Offset(1).Clear ws.UsedRange.Offset(1).Clear ActiveWorkbook.SaveAs "G:\" & sStr ActiveWorkbook.Close End If Wb.Activate Wb.Worksheets("Navigation").Select XIT: With Application ..ScreenUpdating = True ..DisplayAlerts = True End With End Sub -- Kstalker ------------------------------------------------------------------------ Kstalker's Profile: http://www.excelforum.com/member.php...o&userid=24699 View this thread: http://www.excelforum.com/showthread...hreadid=385437 |
unwanted copy
Hi Kristan,
Have you omitted to include the File_exist function? Or have you, perhaps inadvertently, changed the name of the function? --- Regards, Norman "Kstalker" wrote in message ... Norman. Just when I thought I was on the home stretch. I am now getting a Compile Error; Sub or Function not defined. Highlighting the If file_exist("G:) part of the sub. I have shifted the clear content from youir original post but this should not be causing a problem. If you have a chance could you point out what I have done. Thanks again.. Kristan Option Explicit Sub CreateArchive() Dim Wb As Workbook Dim ws As Worksheet Dim ws1 As Worksheet Dim ws2 As Worksheet Dim ws3 As Worksheet Dim ws4 As Worksheet Dim sStr As String Dim Res As Long Application.ScreenUpdating = False On Error GoTo XIT Set Wb = Workbooks("Single Sheet.xls") With Wb Set ws = .Worksheets("Master") Set ws1 = .Worksheets("stageclearer 1") Set ws2 = .Worksheets("stageclearer 2") Set ws3 = .Worksheets("stageclearer 3") Set ws4 = .Worksheets("stageclearer 4") End With sStr = Format(Date, "yymmdd") & " " & "Stage Clearer" If file_exist("G:\" & sStr & ".xls") Then '<<===== CHANGE if worksheet shifted Res = MsgBox("This file already Exists. " _ & " Do you want to overwrite it?", _ vbYesNo + vbCritical, "OVERWRITE FILE ") If Res = vbYes Then ws.Copy ws1.UsedRange.Offset(1).Clear ws2.UsedRange.Offset(1).Clear ws3.UsedRange.Offset(1).Clear ws4.UsedRange.Offset(1).Clear ws.UsedRange.Offset(1).Clear Application.DisplayAlerts = False ActiveWorkbook.SaveAs "G:\" & sStr ActiveWorkbook.Close Application.DisplayAlerts = True End If Else ws.Copy ws1.UsedRange.Offset(1).Clear ws2.UsedRange.Offset(1).Clear ws3.UsedRange.Offset(1).Clear ws4.UsedRange.Offset(1).Clear ws.UsedRange.Offset(1).Clear ActiveWorkbook.SaveAs "G:\" & sStr ActiveWorkbook.Close End If Wb.Activate Wb.Worksheets("Navigation").Select XIT: With Application ScreenUpdating = True DisplayAlerts = True End With End Sub -- Kstalker ------------------------------------------------------------------------ Kstalker's Profile: http://www.excelforum.com/member.php...o&userid=24699 View this thread: http://www.excelforum.com/showthread...hreadid=385437 |
unwanted copy
Cheers Norman. I had ommitted the the file_extension function.... tisk tisk tisk Now my project is complete and running like a well oiled machine. Thanks again for the input. Kristan -- Kstalker ------------------------------------------------------------------------ Kstalker's Profile: http://www.excelforum.com/member.php...o&userid=24699 View this thread: http://www.excelforum.com/showthread...hreadid=385437 |
All times are GMT +1. The time now is 07:08 AM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com