Appendix Thread 2. ( Codes for other Threads, HTML Tables, etc.)

[DocAElstein]

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

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