unwanted copy

K

Kstalker

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
 
S

STEVE BELL

This code closes the activeworkbook without saving it (In Excel 2000)

ActiveWorkbook.Saved = True
ActiveWorkbook.Close

build an if statement to turn it loose...
 
K

Kstalker

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
 
N

Norman Jones

Hi Kristan


Kstalker said:
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
Click to expand...


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.
 
K

Kstalker

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
 
N

Norman Jones

Hi Kristan,

Before responding to your comments, please confirm *which* worksheet in the
SingleSheet.XLS workbook you want to archive. It is only one?
 
K

Kstalker

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
 
N

Norman Jones

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
 
K

Kstalker

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
 
N

Norman Jones

Hi Kristan,

Have you omitted to include the File_exist function? Or have you, perhaps
inadvertently, changed the name of the function?
 
K

Kstalker

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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Copy code that partly works 0
Copy if code 1
New topic from discussion "Align cells with same value - vba almostworking" in this group 0
Copy code failing 2
Code condition 3
VBA Coding Help for Beginner 0
Delete sheets code error requires object 2
Development combinations with exclusion of columns 0

Top