Simple Error Checking on Macro

EE Professionals,

I have a great macro, written by one of the EE Professionals (Dmille) that creates a new Workbook/Worksheet from a Worksheet I have on a Source Workbook.  It then places the new Workbook on the Desktop.  It works great except when I already have a Workbook that has been created and deposited on the Desktop.  What I'd like for the Macro to do is if it sees the new WB with the associated name, that it asks if it can be replaced and simply replace it with the new/refreshed version OR save to a different file with a different name.

Currently, if I have a copy of the WB on the desktop, I get an error on this line:

wkbNew.SaveAs Filename:=Environ("UserProfile") & "\Desktop\" & sWBName


Here is the current code;


Option Explicit


Sub CreateSurvey()
Dim sWBName As String
Dim sWSName As String
Dim bViz As Boolean
Dim bProtect As Boolean
Dim wkb As Workbook
Dim wks As Worksheet
Dim wkbNew As Workbook
Dim wksNew As Worksheet

    sWBName = "Governance_Survey"    'Add path if you wish (e.g. C:\My folder\NewWorkbook)
    sWSName = "Survey"
   
    Set wkb = ThisWorkbook
    Set wks = wkb.Sheets("Survey")
   
    'retain visible "ness" of the survey sheet
    bViz = wks.Visible
       
    'add new workbook with one sheet only
    Application.SheetsInNewWorkbook = 1
    Set wkbNew = Workbooks.Add
    Application.SheetsInNewWorkbook = 3
   
    Set wksNew = wkbNew.ActiveSheet
   
    'name active sheet of new workbook
    wksNew.Name = sWSName
   
    'copy data from original Survey sheet to new Survey sheet
    wks.Cells.Copy
    wksNew.Cells.PasteSpecial xlPasteAll
   
    'now paste values
    wksNew.Cells.PasteSpecial xlPasteValues
   
    'get protection level of original sheet
    bProtect = wks.ProtectContents
   
    'done with original, so reset visibility
    wks.Visible = bViz
       
    'generate range names
    Call generateRangeNames(ThisWorkbook, wkbNew, wksNew)
   
    If bProtect Then wksNew.Protect
   
    wkbNew.SaveAs Filename:=Environ("UserProfile") & "\Desktop\" & sWBName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
    'pick the type of workbook to save
    'xlNormal
    'xlOpenXMLWorkbook
    'xlOpenXMLWorkbookMacroEnabled
    ThisWorkbook.Activate
End Sub

Sub generateRangeNames(wkbSource As Workbook, wkbDest As Workbook, wksDest As Worksheet)
Dim r As Range
Dim rng As Range
Dim wks As Worksheet
Dim nameToCreate As String
Dim nameRangeFormula As String

    Set wks = wkbSource.Sheets("Calc_Engine")
    Set rng = wks.Range("A235", wks.Range("A" & wks.Rows.Count).End(xlUp))
   
    For Each r In rng
        nameToCreate = r.Value
        nameRangeFormula = r.Offset(, 1).Formula
       
        wkbDest.Names.Add Name:=nameToCreate, RefersTo:=nameRangeFormula
    Next r
End Sub
Bright01Asked:
Who is Participating?
 
dlmilleConnect With a Mentor Commented:
Bright - if the file already exists and you want to notify the user to handle that before re-running, just use this code (no need to worry about whether its opened or not - because if it exists, it will still flag and we can advise user-  it needs to be handled):
Sub CreateSurvey()
Dim sWBName As String
Dim sWSName As String
Dim bViz As Boolean
Dim bProtect As Boolean
Dim wkb As Workbook
Dim wks As Worksheet
Dim wkbNew As Workbook
Dim wksNew As Worksheet
Dim wksCheck As Workbook
Dim fName As String

    sWBName = "Governance_Survey"    'Add path if you wish (e.g. C:\My folder\NewWorkbook)
    sWSName = "Survey"
    
    If Dir(Environ("UserProfile") & "\Desktop\" & sWBName & "*.xlsm") <> "" Then
        MsgBox "File: " & sWBName & " already exists.  Please handle before proceeding."
        Exit Sub
    End If
    
    Set wkb = ThisWorkbook
    Set wks = wkb.Sheets("Survey")

    'retain visible "ness" of the survey sheet
    bViz = wks.Visible
        
    'add new workbook with one sheet only
    Application.SheetsInNewWorkbook = 1
    Set wkbNew = Workbooks.Add
    Application.SheetsInNewWorkbook = 3
    
    Set wksNew = wkbNew.ActiveSheet
    
    'name active sheet of new workbook
    wksNew.Name = sWSName
    
    'copy data from original Survey sheet to new Survey sheet
    wks.Cells.Copy
    wksNew.Cells.PasteSpecial xlPasteAll
    
    'now paste values
    wksNew.Cells.PasteSpecial xlPasteValues
    
    'get protection level of original sheet
    bProtect = wks.ProtectContents
    
    'done with original, so reset visibility
    wks.Visible = bViz
        
    'generate range names
    Call generateRangeNames(ThisWorkbook, wkbNew, wksNew)
    
    If bProtect Then wksNew.Protect
    
    wkbNew.SaveAs Filename:=Environ("UserProfile") & "\Desktop\" & sWBName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
    
    On Error GoTo 0
    
    'pick the type of workbook to save
    'xlNormal
    'xlOpenXMLWorkbook
    'xlOpenXMLWorkbookMacroEnabled
    ThisWorkbook.Activate
End Sub

Open in new window


Cheers,

Dave
0
 
dlmilleCommented:
The simplest solution is to opt for the default (replace). By turning DisplayAlerts Off, this can happen.  See the code:

Option Explicit


Sub CreateSurvey()
Dim sWBName As String
Dim sWSName As String
Dim bViz As Boolean
Dim bProtect As Boolean
Dim wkb As Workbook
Dim wks As Worksheet
Dim wkbNew As Workbook
Dim wksNew As Worksheet

    sWBName = "Governance_Survey"    'Add path if you wish (e.g. C:\My folder\NewWorkbook)
    sWSName = "Survey"
    
    Set wkb = ThisWorkbook
    Set wks = wkb.Sheets("Survey")
    
    'retain visible "ness" of the survey sheet
    bViz = wks.Visible
        
    'add new workbook with one sheet only
    Application.SheetsInNewWorkbook = 1
    Set wkbNew = Workbooks.Add
    Application.SheetsInNewWorkbook = 3
    
    Set wksNew = wkbNew.ActiveSheet
    
    'name active sheet of new workbook
    wksNew.Name = sWSName
    
    'copy data from original Survey sheet to new Survey sheet
    wks.Cells.Copy
    wksNew.Cells.PasteSpecial xlPasteAll
    
    'now paste values
    wksNew.Cells.PasteSpecial xlPasteValues
    
    'get protection level of original sheet
    bProtect = wks.ProtectContents
    
    'done with original, so reset visibility
    wks.Visible = bViz
        
    'generate range names
    Call generateRangeNames(ThisWorkbook, wkbNew, wksNew)
    
    If bProtect Then wksNew.Protect
    
    Application.DisplayAlerts = False
    
    wkbNew.SaveAs Filename:=Environ("UserProfile") & "\Desktop\" & sWBName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
    
    Application.DisplayAlerts = True
    
    'pick the type of workbook to save
    'xlNormal
    'xlOpenXMLWorkbook
    'xlOpenXMLWorkbookMacroEnabled
    ThisWorkbook.Activate
End Sub

Sub generateRangeNames(wkbSource As Workbook, wkbDest As Workbook, wksDest As Worksheet)
Dim r As Range
Dim rng As Range
Dim wks As Worksheet
Dim nameToCreate As String
Dim nameRangeFormula As String

    Set wks = wkbSource.Sheets("Calc_Engine")
    Set rng = wks.Range("A235", wks.Range("A" & wks.Rows.Count).End(xlUp))
    
    For Each r In rng
        nameToCreate = r.Value
        nameRangeFormula = r.Offset(, 1).Formula
        
        wkbDest.Names.Add Name:=nameToCreate, RefersTo:=nameRangeFormula
    Next r
End Sub

Open in new window


Dave
0
 
dlmilleCommented:
PS - if you replace line 14 with:

sWBName = "Governance_Survey_" & Format(Now(), "MM_DD_YY-HH-MM")

Then, you'd get a new survey file based on date and time (change to HH-MM-SS for second if you're generating surveys more often than once/minute).

You might want to save in a folder on your desktop if you're going this route, otherwise you'd get a lot of icons on your desktop!

Note:  changes on line 50-54 as well to ensure you have a Survey directory and to save to that directory.

So here's that:

Option Explicit

Sub CreateSurvey()
Dim sWBName As String
Dim sWSName As String
Dim bViz As Boolean
Dim bProtect As Boolean
Dim wkb As Workbook
Dim wks As Worksheet
Dim wkbNew As Workbook
Dim wksNew As Worksheet

    sWBName = "Governance_Survey_" & Format(Now(), "MM_DD_YY-HH-MM")   'Add path if you wish (e.g. C:\My folder\NewWorkbook)
    sWSName = "Survey"
    
    Set wkb = ThisWorkbook
    Set wks = wkb.Sheets("Survey")
    
    'retain visible "ness" of the survey sheet
    bViz = wks.Visible
        
    'add new workbook with one sheet only
    Application.SheetsInNewWorkbook = 1
    Set wkbNew = Workbooks.Add
    Application.SheetsInNewWorkbook = 3
    
    Set wksNew = wkbNew.ActiveSheet
    
    'name active sheet of new workbook
    wksNew.Name = sWSName
    
    'copy data from original Survey sheet to new Survey sheet
    wks.Cells.Copy
    wksNew.Cells.PasteSpecial xlPasteAll
    
    'now paste values
    wksNew.Cells.PasteSpecial xlPasteValues
    
    'get protection level of original sheet
    bProtect = wks.ProtectContents
    
    'done with original, so reset visibility
    wks.Visible = bViz
        
    'generate range names
    Call generateRangeNames(ThisWorkbook, wkbNew, wksNew)
    
    If bProtect Then wksNew.Protect
    
    On Error Resume Next
    MkDir Environ("UserProfile") & "\Desktop\Surveys" 'ensure survey folder exists
    On Error GoTo 0
    
    wkbNew.SaveAs Filename:=Environ("UserProfile") & "\Desktop\Surveys\" & sWBName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
    
    
    'pick the type of workbook to save
    'xlNormal
    'xlOpenXMLWorkbook
    'xlOpenXMLWorkbookMacroEnabled
    ThisWorkbook.Activate
End Sub

Sub generateRangeNames(wkbSource As Workbook, wkbDest As Workbook, wksDest As Worksheet)
Dim r As Range
Dim rng As Range
Dim wks As Worksheet
Dim nameToCreate As String
Dim nameRangeFormula As String

    Set wks = wkbSource.Sheets("Calc_Engine")
    Set rng = wks.Range("A235", wks.Range("A" & wks.Rows.Count).End(xlUp))
    
    For Each r In rng
        nameToCreate = r.Value
        nameRangeFormula = r.Offset(, 1).Formula
        
        wkbDest.Names.Add Name:=nameToCreate, RefersTo:=nameRangeFormula
    Next r
End Sub

Open in new window


Dave
0
Introducing Cloud Class® training courses

Tech changes fast. You can learn faster. That’s why we’re bringing professional training courses to Experts Exchange. With a subscription, you can access all the Cloud Class® courses to expand your education, prep for certifications, and get top-notch instructions.

 
Bright01Author Commented:
Dave,

Not that simple! ;-)

I substituted the code but get an error message saying I have to save it as a different file.  But since it is autogenerated, it doesn't give me a message box to rename the sheet and redirect it such as a "Save As"..........

Is there a way to prompt the user to Save As.....without it being an error response?

B.
0
 
dlmilleCommented:
Bright - try my latest post, if you want to auto-generate a new survey name and save in the survey folder.

If not, then you need to be more specific - like advising me if you already have a survey file up - which would cause that kind of error message.  You can't save a file to an existing file you already have open.

It should be that simple, lol  crossing fingers.

Dave
0
 
Bright01Author Commented:
Dave,

So here's what I think;  I simply need a message, if the file already exists or is open, that says, "You must close the Survey File on your Desktop to save a new Survey Form."

Here's where we may really fall off the cliff on this.  Remember the macro you wrote me to auto generate the range names?  I do believe they are hardwired to a WB/WS name.  If I replicate the sheet with different names, I don't think the range names will get generated.  So to keep this simple (and yes..... it's working now), I'd just like to redirect the user before they have an error.

Make sense?

B.
0
 
NorieVBA ExpertCommented:
If you want to check if a file exists you can use Dir, it returns "" if the file doesn't exist.
If Dir(Filename:=Environ("UserProfile") & "\Desktop\" & sWBName) = "" Then
    wkbNew.SaveAs Filename:=Environ("UserProfile") & "\Desktop\Surveys\" 
Else
   ' workbook already exists
End If

Open in new window

I've not filled in the part when the workbook exists because I'm not sure what you want to do.

You mention asking the user to close a workbook?

What if they don't have it open though?
0
 
Bright01Author Commented:
So currently, the Workbook has a rather complex pair of Macros that work together to;

1.) Create a new WB/WS from a existing Template in the Source WB.
2.) Place that new file on the desktop for use (it's a survey).
3.) Another macro creates a set of range names that are associated with the survey
4.) Those range names are then used to return the data (import) back into the Source WB.

Right now, if I try to create a new Survey, and one exists, it asks to be replaced.  However, if the workbook is open, I get an error message.  I simply want to handle the error with perhaps a little instruction to the user such as "You must first close the existing Survey Workbook before proceeding".  Something that simple so the user doesn't say, "this doesn't work".

To get any more complex on the save process and I might disrupt the automatic range name macro since it is tied to a WB/WS name.

B.
0
 
NorieVBA ExpertCommented:
Which workbook is the code located in?
0
 
Bright01Author Commented:
It's in a module in the Source WB (Governance_Workbook).
0
 
NorieVBA ExpertCommented:
Is that the only workbook open, until you create the new workbook of course?
0
 
Bright01Author Commented:
Not sure.  Most of the time "yes".   Is it critical that no other workbooks are open?
0
 
NorieVBA ExpertCommented:
So you have a workbook 'Governance_Survey' which has code in it to create a new workbook which you try to save with the name 'Governance_Survey'?

I'm sorty but I must be missing something because that doesn't seem quite right.
0
 
Bright01Author Commented:
No.  I have a WB (Source) called "Governance Workbook" that has a macro that generates a WB called (by the Macro) Goverance_Survey with a Worksheet in it called "Survey" and that is the WB that is placed on the desktop.  If I try to add another WB using the same Macro, if the Gov_Survey is open, I get the error.  If it is not, it asks if we should replace it.

Make sense?

B.
0
 
NorieConnect With a Mentor VBA ExpertCommented:
Why not close the new workbook after it's been saved?
wkbNew.SaveAs Filename:=Environ("UserProfile") & "\Desktop\Surveys\" & sWBName, FileFormat:=xlOpenXMLWorkbookMacroEnabled

wkbNew.Close 

Open in new window

So when you try to create another new workbook you won't get the error about it being open.

You will still get the message about overwriting though.
0
 
dlmilleCommented:
Of course you always have the opportunity to close it but I think the goal is to then review the survey so then you'd have to manually reopen correct?
0
 
Bright01Author Commented:
Hey guys!  Thank you!  Imnorie, always more difficult when you are not familiar with the original Macro; but you did great in pursuing this and your idea of having the macro close the WB/WS was good and creative.  Dave, thanks for adding the error code; it's simple and works to force the user to handle the Survey that has been created before saving another one.

Thanks to both of you,

B.
0
 
NorieVBA ExpertCommented:
Dave

The problem seems to be, as I understand it anyway, that a workbook is created and not closed and then another workbook is created.

The code tries to save the second workbook created with the same name as the first workbook created, and that's when you get the 'workbook is open' error.

But I could be way out.

Your idea of adding a the date/time to the workbook name should work, unless they create more a workbook within a minute of another.
0
 
dlmilleCommented:
I agree that is what was causing the error.  Either creating workbook with different name, closing after survey is created, or prompting (appears to be Bright's choice) are three good options.  And I posted code to add seconds to the filename if needed.

I think we got it covered, at least for now.  Sometimes the work process has to get ahead of the macros to sort it all out.

Cheers,

Dave
0
 
Bright01Author Commented:
Dave,

Question for you.  If I went with your approach to timestamp each copy that is created, would the range names transfer over appropriately?  As you may recall, we have put a range name and a range formula with each range we wanted to create in the destination WS (Survey).  If I had multiple WBs that are created, would the range names transfer correctly?

B.
0
 
dlmilleCommented:
The creation of range names is independent of the filename being created, so you should be in good shape.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.