Solved

Auto Generating Range Names in New Workbook

Posted on 2012-03-24
12
274 Views
Last Modified: 2012-03-27
EE Professionals,

I have this great little Macro that Dmille (Dave) wrote for me that auto generates a Survey from a Main Workbook.  Here's the challenge, in order to input the data back into the MAIN WB/WS, I need to define the range names of the sets of data in the new Survey WB/WS.  I need a macro or macro code within the existing Macro that allows me to specify ranges and range names that get created when the new WB/WS is created.  If you build the macro and put in a few hints; I'll put in the range names and parameters.

Thank you in advance,

B.
testSurveyCopy-r1.xlsm
0
Comment
Question by:Bright01
  • 6
  • 6
12 Comments
 
LVL 41

Accepted Solution

by:
dlmille earned 500 total points
ID: 37761600
Ok.  I added a simple generateNames() routine that gets called when you run the create survey routine.

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("Sheet1")
    Set rng = wks.Range("B15", wks.Range("B" & 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


In the attached, the Sheet1 has a list of range names to create, and to the right is the formulas that the range names should hold.  Ensure you prefix all range names with
=Survey!whatever you want, when you reference the survey sheet.

I wish we knew what was causing your link problems so this would be easier, however, if its only a few range names, perhaps this won't be that big an issue.

See attached.

Dave
testSurveyCopy-r2.xlsm
0
 

Author Comment

by:Bright01
ID: 37762656
Dave,

Tested it.  And I'm a little confused.  In the original state that you sent me the macro, it creates a new Survey WB/WS and places it on the desktop as designed.  When I go into the new WB/WS on the desktop, open Range Name Manager, there are range names but not editable. OK..... so I deleted the WS.  Next I put in new names; substituting Cat1, Cat2 etc. etc., unprotected the original Sheet and put in new Range Name formulas (e.g. =F12:F22).  When I fire the Macro I get a error;

wkbDest.Names.Add Name:=nameToCreate, RefersTo:=nameRangeFormula

Upon further analysis....it appears to be a problem, not with the formulas, but with the change of the Range name. So go into your r2 version, and substitute Cat1 in B15....fire the macro and you should get the same error.

Let me describe what I'm attempting to do.  When the new WB/WS (i.e. Survey) is created and deposited to the Desktop, it should have a set of generated range names.  Those range names will eventually be used to import the Survey data BACK into the original Workbook once complete.

Make sense?

B.
0
 
LVL 41

Expert Comment

by:dlmille
ID: 37763152
I guess we're both confused.  Note, that the new survey is protected, correct?  So, you have to unprotect the sheet to change range names.

You cannot create a range name that is the same name as a cell reference.

CAT1 is column CAT, row 1.

;)

So, try again, creating range names say with 4 letters and you shouldn't be using any reserved words from cell names, anyway.

Dave
0
 

Author Comment

by:Bright01
ID: 37763921
ok.... here's what I have;

1.) I've made the range names  Category1, Category 2, etc. ( I have 12 of them).  They are in the Source WB in the Calc WS.   I have the code (macros) you sent me, in a Public Module (14).  

2.)  The Survey WS in the Source WB is not protected.  

3.)  When I execute the Macro I get an error  Runtime error 9, "script out of range";      

On this line:   Set wks = wkbSource.Sheets("Sheet1")

And it creates a Workbook # vs. the perscribed WB in the Macro...........

I'm probably doing something wrong.  So to retrace the steps;

1.) I took your macro; put it in a public module.
2.) I assigned the macro to a button that fires the macro.
3.) Here is the code I have;

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("Sheet1")
    Set rng = wks.Range("B15", wks.Range("B" & 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

What am I doing wrong?

B.
0
 
LVL 41

Expert Comment

by:dlmille
ID: 37763961
The error reference to "Sheet1" should be an alert that you probably don't have one of those, correct?

So, you'll need to ensure that that is referencing the sheet where you're putting the range name definitions.

So change:

Set wks = wkbSource.Sheets("Sheet1") to

set wks = wkbSource.Sheets("the sheet name where you put the range name setup stuff")

Cheers,

Dave
0
 
LVL 41

Expert Comment

by:dlmille
ID: 37766219
So is there a reason you acceopted your solution an did not award points?

;)
0
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 

Author Closing Comment

by:Bright01
ID: 37766325
Yeah...add a class on "how to properly navigate Expert Exchange" to my list of educational requirements!

Sorry.

And "thank you"!

B.
0
 
LVL 41

Expert Comment

by:dlmille
ID: 37766520
I'm glad I put my coffee down this morning before reading your response, lol.

You're welcome.

Dave
0
 

Author Comment

by:Bright01
ID: 37771687
Dave,

Perhaps I need to ask this as another question; however, I'm having a problem with the macro above.  Here's the problem.  I've simplified the Range name to be a single range name that includes all the data I'm trying to cover in the created Range on the Survey Sheet.  I have changed the set wks = wkbSource.Sheets to the correct location of the Range with the cell to the right representing the correct range formula.  When it creates the new sheet on the desktop it does create a new range name and range; howver, it displaces the range by one column off (D and E, instead of C and D), and several rows down (i.e. not a complete match up).  I've tried to trouble shoot this but to no avail.

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("A249", 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

and the formula in A249 and B249 is

                        A                                 B
249      All Categories       =Survey!C4:D207

Any ideas?

Thank you,

B.
0
 
LVL 41

Expert Comment

by:dlmille
ID: 37772306
change the reference to absolution (as opposed to relative) addressing:

AllCategories =Survey!$C$4:$D$207

Cheers,

Dave
0
 

Author Comment

by:Bright01
ID: 37772520
I should have  thought of that!  Works to a T.


B.
0
 

Author Comment

by:Bright01
ID: 37772713
I'm opening up what you may think is a simple related question concerning a small piece of error checking on this macro you wrote.  Hopefully you'll take a quick look.

B.
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
InternetExplorer object in Excel VBA. 4 21
ActiveX Listbox Multi Select in Excel 2010 8 16
Sum iF  based on a null cell 11 29
Help Updated Qtr 2 0
Drop Down List with Unique/Distinct Values (Part II - ComboBox or ListBox and Data Validation List Bonus!) David Miller (dlmille) Intro This article focuses on delivering unique, sorted lists to list objects (e.g., ComboBox, ListBox) and Dat…
Introduction This Article is a follow-up to my Mappit! Addin Article (http://www.experts-exchange.com/A_2613.html), it was inspired by an email posting I made to EUSPRIG (http://www.eusprig.org/index.htm), I will briefly cover: 1) An overvie…
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.

911 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

18 Experts available now in Live!

Get 1:1 Help Now