Output Survey to Desktop

EE Professionals,

I have a great little macro that Dmille wrote for me some time back.  I've got one change I need to make to it.  It not only puts a copy of the Survey on my desktop, but it generates a set of Ranges that are used in a later macro that imports the data back.  

Here is what I need.  In this next version, I do not need to autogenerate the Ranges in the Survey.  Instead, I simply need to output a single Range (Name).  Here is the line that needs to be modified or changed to refer or call a Range (we can call it "Capabilities_Range";

'generate range names
    Call generateRangeNames(ThisWorkbook, wkbNew, wksNew)
    If bProtect Then wksNew.Protect

The full code is below.

'This Module is used to create a Survey Workbook

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
Dim wksCheck As Workbook
Dim fName As String

    sWBName = "Capability_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
    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
End Sub
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

>>In this next version, I do not need to autogenerate the Ranges in the Survey.  Instead, I simply need to output a single Range (Name).  Here is the line that needs to be modified or changed to refer or call a Range (we can call it "Capabilities_Range";

I'm not exactly sure what you need, but I'll give it a couple shots.

First, if you have a range defined in your original workbook called, "Capabilities_Range" and you'd like to create that new range with the same reference the old workbook has and apply it to the new workbook, you can use:

    'generate range names
    'Call generateRangeNames(ThisWorkbook, wkbNew, wksNew)
    wkbNew.Names.Add Name:="Capabilities_Range", RefersTo:=ThisWorkbook.Names("Capabilities_Range").RefersTo
    If bProtect Then wksNew.Protect

Open in new window

However, if you have created only one range name reference, as with the last example you cited, and you want to create that range name,  using the reference on Sheet1, Range B15, then you can use:

    'generate range names
    wkbNew.Names.Add Name:="Capabilities_Range", RefersTo:=wkb.Sheets("Sheet1").Range("B15").Formula
    If bProtect Then wksNew.Protect

Open in new window

Hope that gets it, otherwise, please give me a few more clues.


Bright01Author Commented:

Next clue..... (just kidding)........

So it's the former not the latter.  I have a range name in the original workbook that I simply want to copy over to the new workbook.  This is different then the original one you created for me since I'm not importing back in the survey results; simply copying and placing the survey on the desktop.  When I install the code you provided and commented out the generate_range_names subroutine, and then run it, it produces the Survey, places it on the desktop, has the correct range, but gives me a simple debug error.  1004 Application Defined or Object Defined Error.  The debug line is:

wkbNew.Names.Add Name:="Capability_Assessment_Range", RefersTo:=ThisWorkbook.Names("Capabilitity_Assessment_Range").RefersTo

(I renamed the range name to "Capability_Assessment_Range" from "Capabilities_Range").

Additionally, it doesn't name the workbook.

Hope that helps; sorry I can't do a better job debugging...........

Thank you,

Please let me know what the range name "Capability_Assessment_Range" is referring to.

Is this range already on the Survey Sheet?  If its the only range name on the Survey sheet and it refers to a location on that sheet, then we can just copy the sheet, and not the cells over, that way the range would get copied over as well.

It probably didn't save the workbook because you got an error in the process, and the next step was to save the workbook, so that problem should go away.

Can you upload a dummy version of the file you're working with so I can debug this more quickly?

The attached is my dummy version of your survey and the code works, so I need more information about "Capability_Assessment_Range" - is it defined at the Workbook or Survey scope?  (See Names manager and advise scope of this range).  Also, what is the formula that Capability_Assessment_Range has?  e.g., what range is it pointing to?



Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Bright01Author Commented:

Much thanks!  Works great.  Sorry for the unclear request.  Several of the Workbooks that have been created have gotten fairly complex and it's not always easy to create a sample.  In the future, however, I will invest more time in building out a prototype or sample so as to make it easier to help solve these issues.  Again, "very much appreciate" all of your hard "and smart" work.

All the best,

It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Applications

From novice to tech pro — start learning today.