Solved

Output Survey to Desktop

Posted on 2012-04-12
4
271 Views
Last Modified: 2012-04-16
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
    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
0
Comment
Question by:Bright01
  • 2
  • 2
4 Comments
 
LVL 41

Expert Comment

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

Cheers,

Dave
0
 

Author Comment

by:Bright01
ID: 37848341
Dave,

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,

B.
0
 
LVL 41

Accepted Solution

by:
dlmille earned 500 total points
ID: 37849419
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?

Thanks,

Dave
createSurvey-r1.xlsm
0
 

Author Closing Comment

by:Bright01
ID: 37850675
Dave,

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,

B.
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Introduction This Article briefly covers methods of calculating the NPV and IRR variants in Excel as well as the limitations in calculating and interpreting IRR results. Paraphrasing Richard Shockley, author of my favourite finance reference tex…
Many companies are making the switch from Microsoft to Google Apps (https://www.google.com/work/apps/business/). Use this article to learn more about what Google Apps has to offer and to help if you’re planning on migrating to Google Apps. It is …
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.

744 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

14 Experts available now in Live!

Get 1:1 Help Now