Second main Demo Code in support of this Thread:
http://www.excelfox.com/forum/showth...-a-named-range
For Posts from:
http://www.excelfox.com/forum/showth...0819#post10819
Code:Sub FoxyMultiCellNamedRanges() 10 Rem -2 Range Info etc. 20 Dim WbMain As Workbook, dataWb1xls As Workbook, dataWb2xlsx As Workbook 30 Set WbMain = Workbooks("MasturFile.xlsm") 'Set WbMain = ThisWorkbook 40 Workbooks.Open Filename:=ThisWorkbook.Path & "\Data1.xls" 50 Set dataWb1xls = Workbooks("Data1.xls") 60 Workbooks.Open Filename:=ThisWorkbook.Path & "\Data2.xlsx" 70 Set dataWb2xlsx = Workbooks("Data2.xlsx") 80 ' 90 Dim LisWkBkPath As String: Let LisWkBkPath = "=" & "'" & ThisWorkbook.Path & "\" 100 '-2b) Some variables to hold a full reference string which we will use in places where we might need any of these variations for a cell reference Sheet7!B5 [myWorkbook.xlsm] Sheet4!B5 'G:\Desktop\MyFolder\[DataFile.xlsx]Tabelle1'!B5 The last one is the form we hold in the variables. Excel and Excel VBA , usually has no issues if you use the full reference in situations where one of the shorter versions may have been sufficient. But on the other hand, you may get unexpected problems if you used a shorter version , and Excel then guesses wrongly for the remaining part, which I believe it always adds internally, ( possibly at some compiling stage ) , before it uses it. 110 Dim MBkTab1B5 As String ' To hold full string reference to B5 in Master Workbook 120 Let MBkTab1B5 = "=" & "'" & ThisWorkbook.Path & "\" & "[" & "MasturFile.xlsm" & "]" & "Tabelle1" & "'" & "!" & "B5" 130 Dim Dat1Tab1B5 As String ' B5 in data1 workbook 140 Let Dat1Tab1B5 = "=" & "'" & ThisWorkbook.Path & "\" & "[" & "Data1.xls" & "]" & "Tabelle1" & "'" & "!" & "B5" 150 ' 160 Rem -1 Error handler 170 On Error GoTo ErrorHandlerCodeSection: 180 GoTo PastErrorHandler 190 ErrorHandlerCodeSection: 200 MsgBox prompt:="Code errored at line " & Erl & " , error was:" & vbCrLf & vbCrLf & Err.Number & " " & Err.Description 210 Debug.Print Err.Number & " " & Err.Description 220 Resume Next 230 PastErrorHandler: 240 Rem 0 Clean up 250 '0a) remove any name objects made in last routine in the main file or the two data files 260 Dim WkBk As Workbook 270 For Each WkBk In Workbooks 280 Call FukYaWkBkNames(WkBk) 290 'Call GeTchaNms(280, WkBk) 300 Next WkBk 310 Workbooks("Data1.xls").Close savechanges:=True 320 Workbooks("Data2.xlsx").Close savechanges:=True 330 '0b) clear the entire data ranges in the first worksheet in the main workbook, both headers and data 340 ThisWorkbook.Worksheets.Item(1).Range("B5:C12").ClearContents 350 Rem _1) Data1 "Food" header 360 '1a) Data1 cell Workbook Scoped to its workbook : Info needed for a range in that data file is held in the workbooks name objects collection object of that workbook 370 Workbooks.Open Filename:=ThisWorkbook.Path & "\Data1.xls" 380 Set dataWb1xls = Workbooks("Data1.xls") ' We need this open for the referred to range in the RefersTo:= range reference below 390 dataWb1xls.Names.Add Name:="Dta1Foodheader", RefersTo:=Application.Range(Dat1Tab1B5) ' A personal preference of mine is , once again, to use a full reference. This time it is in the Refers To range. This Refers To:= argument would never need the full file path reference, as the range referenced must be to a range in an open book. Never the less, as usual, VBA accepts the full reference 400 dataWb1xls.Close savechanges:=True ' I don't need the workbook open for the next line to work, but I made Added a named range object so I must save the changes for the next line to work as that named range is referenced 410 Let Application.Range(MBkTab1B5).Value = LisWkBkPath & "Data1.xls'!Dta1Foodheader" ' "Going" to Workbook Data1.xls 420 Let Application.Range(MBkTab1B5).Value = LisWkBkPath & "[Data1.xls]Tabelle4'!Dta1Foodheader" ' "Going" to any worksheet in Data1.xls 430 Rem 2 Experiments with named ranges in the LHS , like in Range("rngNamed") = 440 '2b) Workbooks Scope to main workbook: Info for named range is in Name Objects collection of Main workbook 450 WbMain.Names.Add Name:="MainFoodheader", RefersTo:=Application.Range(MBkTab1B5) 460 Let Application.Range(LisWkBkPath & WbMain.Name & "'!MainFoodheader").Value = LisWkBkPath & "Data1.xls'!Dta1Foodheader" ' LHS is going to workbook Data2.xlsx RHS is "Going" to Workbook Data1.xls 470 Rem 3 Bring in Header "Suppliment" from data 2 workbook directly without named ranges 480 Workbooks.Open Filename:=ThisWorkbook.Path & "\Data2.xlsx" 490 Set dataWb2xlsx = Workbooks("Data2.xlsx") ' Needed for next line 500 Let Application.Range("=" & "'" & WbMain.Path & "\" & "[" & WbMain.Name & "]" & WbMain.Worksheets.Item(1).Name & "'" & "!" & "B10").Value = "=" & "'" & dataWb2xlsx.Path & "\" & "[" & dataWb2xlsx.Name & "]" & dataWb2xlsx.Worksheets.Item(1).Name & "'" & "!" & "B10" 510 '3b) "Fixed vector" B11 into main workbook at B11 520 Let Application.Range("=" & "'" & WbMain.Path & "\" & "[" & WbMain.Name & "]" & WbMain.Worksheets.Item(1).Name & "'" & "!" & "B11").Value = "=" & "'" & dataWb2xlsx.Path & "\" & "[" & dataWb2xlsx.Name & "]" & dataWb2xlsx.Worksheets.Item(1).Name & "'" & "!" & "B11" 530 '3c) "Fixed vector" B11 into main workbook into B11 C11 B12 and C12 540 Let Application.Range("=" & "'" & WbMain.Path & "\" & "[" & WbMain.Name & "]" & WbMain.Worksheets.Item(1).Name & "'" & "!" & "B11:C12").Value = "=" & "'" & dataWb2xlsx.Path & "\" & "[" & dataWb2xlsx.Name & "]" & dataWb2xlsx.Worksheets.Item(1).Name & "'" & "!" & "B11" 550 dataWb2xlsx.Close savechanges:=False 560 ' 570 Application.Range("=" & "'" & WbMain.Path & "\" & "[" & WbMain.Name & "]" & WbMain.Worksheets.Item(1).Name & "'" & "!" & "B11:C12").ClearContents ' remove the data from the main file from data file 2 so as to do the same again using named ranges in the next code section, Rem 4 580 Rem 4 named ranges for data ranges in data workbooks and main file 590 '4a) Workbook to store name range object 600 Dim WbNmeObjs As Workbook 610 Workbooks.Open Filename:=ThisWorkbook.Path & "\StoredNamedRangeNameObjects.xls" 620 Set WbNmeObjs = Workbooks("StoredNamedRangeNameObjects.xls") 630 Call FukYaWkBkNames(WbNmeObjs) 640 Call GeTchaNms(640, WbNmeObjs) 650 '4b) named ranges for data in data range from data 1 workbook, "Data1.xls 660 Workbooks.Open Filename:=ThisWorkbook.Path & "\Data1.xls" 670 Set dataWb1xls = Workbooks("Data1.xls") ' We need this open for the referred to range in the RefersTo:= range reference below 680 WbNmeObjs.Worksheets("DataFileNameObjects").Names.Add Name:="NmsObjDta1Data", RefersTo:=Application.Range("='" & ThisWorkbook.Path & "\[Data1.xls]Tabelle1'!B6:C7") 690 Call GeTchaNms(690, WbNmeObjs) 700 '4c) named ranges for data in data range from data 2 workbook, "Data2.xlsx 710 Workbooks.Open Filename:=ThisWorkbook.Path & "\Data2.xlsx" 720 Set dataWb2xlsx = Workbooks("Data2.xlsx") ' We need this open for the referred to range in the RefersTo:= range reference below 730 WbNmeObjs.Worksheets("DataFileNameObjects").Names.Add Name:="NmsObjDta2Data", RefersTo:=Application.Range("='" & ThisWorkbook.Path & "\[Data2.xlsx]Tabelle1'!B11:C12") 740 Call GeTchaNms(740, WbNmeObjs) 750 '4d) named ranges for data import ranges in main workbook, ( This workbook ) 760 '4d(i) data from Data 1 file import range in main book 770 WbNmeObjs.Worksheets("MainFileNameObjects").Names.Add Name:="NmsObjDta1Import", RefersTo:=Application.Range("='" & ThisWorkbook.Path & "\[MasturFile.xlsm]Tabelle1'!B6:C7") 780 '4d(ii) data from Data 2 file import range in main book 790 WbNmeObjs.Worksheets("MainFileNameObjects").Names.Add Name:="NmsObjDta2Import", RefersTo:=Application.Range("='" & ThisWorkbook.Path & "\[MasturFile.xlsm]Tabelle1'!B11:C12") 800 Call GeTchaNms(800, WbNmeObjs) 810 ' Close data books - I don't need them open to get at their named range data or their named range data 820 dataWb1xls.Close savechanges:=False ' I needed the workbook open for the referes to range reference and the GeTchaNms( ) to work, but i added no names to it, so I did not intentiionally make any changes, so I will close with changes false in case I acidentally changed anything 830 dataWb2xlsx.Close savechanges:=False ' I needed the workbook open for the referes to range reference and the GeTchaNms( ) to work, but i added no names to it, so I did not intentiionally make any changes, so I will close with changes false in case I acidentally changed anything 840 Rem 5 Using the Added data named ranges to bring in data from the data files into the main workbook 850 '5a) Food data data range ( B6:C7 in main File and B6:C7 in data 1 file ) 860 Let Application.Range("='" & ThisWorkbook.Path & "\[StoredNamedRangeNameObjects.xls]MainFileNameObjects'!NmsObjDta1Import").FormulaArray = "='" & ThisWorkbook.Path & "\[StoredNamedRangeNameObjects.xls]DataFileNameObjects'!NmsObjDta1Data" 870 '5a)(ii) As file "StoredNamedRangeNameObjects.xls" is open we can also use 880 Let Application.Range("='[StoredNamedRangeNameObjects.xls]MainFileNameObjects'!NmsObjDta1Import").FormulaArray = "='[StoredNamedRangeNameObjects.xls]DataFileNameObjects'!NmsObjDta1Data" 890 '5b) Food data data range ( B11:C12 in main File and B11:C12 in data 2 file ) 900 Let Application.Range("='" & ThisWorkbook.Path & "\[StoredNamedRangeNameObjects.xls]MainFileNameObjects'!NmsObjDta2Import").FormulaArray = "='" & ThisWorkbook.Path & "\[StoredNamedRangeNameObjects.xls]DataFileNameObjects'!NmsObjDta2Data" 910 '5b)(ii) As file "StoredNamedRangeNameObjects.xls" is open we can also use 920 Let Application.Range("='[StoredNamedRangeNameObjects.xls]MainFileNameObjects'!NmsObjDta2Import").FormulaArray = "='[StoredNamedRangeNameObjects.xls]DataFileNameObjects'!NmsObjDta2Data" 930 '5c) 940 WbNmeObjs.Close savechanges:=True ' Save the named range info on closing 950 '5d) Optional Change all formulas to their values 960 Let WbMain.Worksheets.Item(1).UsedRange.Value = WbMain.Worksheets.Item(1).UsedRange.Value 970 Rem 6 Final check of all named ranges 980 '6a) Open all workbooks so as to access Named range objects in them 990 Workbooks.Open Filename:=ThisWorkbook.Path & "\Data1.xls" 1000 Set dataWb1xls = Workbooks("Data1.xls") 1010 Workbooks.Open Filename:=ThisWorkbook.Path & "\Data2.xlsx" 1020 Set dataWb2xlsx = Workbooks("Data2.xlsx") 1030 Workbooks.Open Filename:=ThisWorkbook.Path & "\StoredNamedRangeNameObjects.xls" 1040 Set WbNmeObjs = Workbooks("StoredNamedRangeNameObjects.xls") 1050 '6b) Loop through all open workbooks and check named range object info 1060 Dim Wbtemp As Workbook 1070 For Each Wbtemp In Workbooks ' Going through each workbook in the Workbooks collection object of open workbooks 1080 Call GeTchaNms(1080, Wbtemp) '1085 If Wbtemp.Name <> ThisWorkbook.Name Then Wbtemp.Close savechanges:=False ' Close all but this workbook - can't do this here - I might need them in the next use of GeTchaNms 1090 Next Wbtemp 'close workbooks 1100 For Each Wbtemp In Workbooks ' Going through each workbook in the Workbooks collection object of open workbooks 1110 If Wbtemp.Name <> ThisWorkbook.Name Then Wbtemp.Close savechanges:=False ' Close all but this workbook 1120 Next Wbtemp End Sub
Bookmarks