Solved

Simple Error Checking on Macro

Posted on 2012-03-27
21
248 Views
Last Modified: 2012-03-27
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
0
Comment
Question by:Bright01
  • 8
  • 7
  • 6
21 Comments
 
LVL 41

Expert Comment

by:dlmille
ID: 37772789
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
 
LVL 41

Expert Comment

by:dlmille
ID: 37773119
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
 

Author Comment

by:Bright01
ID: 37773123
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
 
LVL 41

Expert Comment

by:dlmille
ID: 37773137
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
 

Author Comment

by:Bright01
ID: 37773176
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
 
LVL 33

Expert Comment

by:Norie
ID: 37773213
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
 

Author Comment

by:Bright01
ID: 37773262
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
 
LVL 33

Expert Comment

by:Norie
ID: 37773334
Which workbook is the code located in?
0
 

Author Comment

by:Bright01
ID: 37773343
It's in a module in the Source WB (Governance_Workbook).
0
 
LVL 33

Expert Comment

by:Norie
ID: 37773367
Is that the only workbook open, until you create the new workbook of course?
0
6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

 

Author Comment

by:Bright01
ID: 37773487
Not sure.  Most of the time "yes".   Is it critical that no other workbooks are open?
0
 
LVL 33

Expert Comment

by:Norie
ID: 37773557
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
 

Author Comment

by:Bright01
ID: 37773583
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
 
LVL 33

Assisted Solution

by:Norie
Norie earned 100 total points
ID: 37773613
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
 
LVL 41

Accepted Solution

by:
dlmille earned 400 total points
ID: 37773619
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
 
LVL 41

Expert Comment

by:dlmille
ID: 37773641
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
 

Author Closing Comment

by:Bright01
ID: 37773657
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
 
LVL 33

Expert Comment

by:Norie
ID: 37773698
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
 
LVL 41

Expert Comment

by:dlmille
ID: 37773852
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
 

Author Comment

by:Bright01
ID: 37773875
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
 
LVL 41

Expert Comment

by:dlmille
ID: 37774015
The creation of range names is independent of the filename being created, so you should be in good shape.
0

Featured Post

Top 6 Sources for Identifying Threat Actor TTPs

Understanding your enemy is essential. These six sources will help you identify the most popular threat actor tactics, techniques, and procedures (TTPs).

Join & Write a Comment

Dealing with unintended Excel Active-X resizing quirks (VBA code simulates "self correction") David Miller (dlmille) Intro Not everyone is a fan of Active-X controls in spreadsheets (as opposed to the UserForm approach, the older Form controls …
This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
The viewer will learn how to simulate a series of sales calls dependent on a single skill level and learn how to simulate a series of sales calls dependent on two skill levels. Simulating Independent Sales Calls: Enter .75 into cell C2 – “skill leve…
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.

762 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now