Home |
Search |
Today's Posts |
|
#1
![]()
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
![]()
I had been using Harlan Grove's PULL function in order to link to data in another workbook that wasn't necessarily currently
open in Excel. The PULL function allows you to specify the details of your linked range as a cell value (unlike a direct link), similar to the INDIRECT function. However, INDIRECT doesn't work with closed workbooks. I like Harlan's PULL function because the code is open and can be easily copied and pasted into additional VBA workbooks as required so that no add-ins are needed. (I have not had much experience with using INDIRECT.EXT via the MoreFunc add-in, although it is possible to "attach" MoreFunc to a workbook so that functions can be used without the add-in being installed.) The PULL function works well - however, it can be slow to use when returning large ranges of cells. For example, we had a spreadsheet that was taking 5 minutes to update when using PULL to refer to a range of 3000 cells. So I looked into creating an alternative function that would be more suited to my circumstance. I feel I was successful and wanted to share my findings here, since the publishing of the PULL function was very helpful to me. (Harlan - I hope that you don't mind that I have used some of your ideas in the new function.) The PULL function uses the ExecuteExcel4Macro command to get values from a cell from a closed workbook. The LINKEDRANGE function that I present here differs from PULL in that it actually opens the linked workbook (in a separate Excel instance, since spreadsheets cannot be normally be opened in a UDF), gets the values it needs and closes the workbook. LINKEDRANGE may be faster than PULL when returning ranges of values from linked workbooks. LINKEDRANGE may be slower than PULL when returning single values or small ranges. Furthermore, LINKEDRANGE can be used to link to named ranges that refer to a range of more than one cell. (PULL works with named ranges that refer to a single-cell only.) The VBA code and sample spreadsheets are located he http://www3.sympatico.ca/sstackho/LinkedRange.zip The .bas file can be used for easy importing into spreadsheets. Although I have tested the code on a couple of machines, it certainly will not be as bulletproof as the PULL function. Harlan has added several layers of armor to the PULL function over the years so that it works on more Excel versions and more operating systems. Since I don't fully understand all of the error-checking logic in the PULL function, I wasn't comfortable adding it to the LINKEDRANGE function. Harlan or anybody: please feel free to make this function better by adding any additional logic as you see fit. I will paste the code below, although it might not look very good with line-wrapping, etc. The code is also available at the link above. '------------------------------------------------- '------------------------------------------------- Option Explicit Function LINKEDRANGE(Link As String) As Variant ' Developed by Shawn Stackhouse ' Inspired (and partially developed) by Harlan Grove and his PULL function ' that was in turn inspired by Bob Phillips and Laurent Longre '----------------------------------------------------------------- 'This code is free software; you can redistribute it and/or modify 'it under the terms of the GNU General Public License as published 'by the Free Software Foundation; either version 2 of the License, 'or (at your option) any later version. '----------------------------------------------------------------- ' Version History ' ' v1 - 2006-08-24 ' v1.1 - 2006-08-25 ' - changed structure to have the function accept a single input and split out the LINKREFERENCE logic to a separate function ' - fixed problem with conflict between workbook-level and worksheet-level named ranges ' Purpose: ' This user-defined function can be used to get values from another spreadsheet, even if it is not open. ' ' This provides similar functionality to using regular Excel links, but allows the locations and names of ' linked workbooks to be specified via cells. ' ' LINKEDRANGE provides similar functionality to Harlan Grove's PULL function. ' ' LINKEDRANGE differs from Harlan Grove's PULL function in that LINKEDRANGE actually opens the linked workbook (in a ' separate Excel instance, since spreadsheets cannot be normally be opened in a UDF) to get the linked values. ' Furthermore, LINKEDRANGE can be used to link to named ranges that refer to more than one cell. ' ' LINKEDRANGE may be faster than PULL when returning ranges of values from linked workbooks. LINKEDRANGE may ' be slower than PULL when returning single values or small ranges. ' **** NOTE **** ' This function requires a full recalculation (Ctrl+Alt+F9) in order to update values ' Function Output: ' - a range of variable size ' - to return a range of cells, use LINKEDRANGE as a formula array (Ctrl+Shift+Enter) Dim xlapp As Object, xlwb As Workbook, xlws As Worksheet Dim r As Range, iChrPos As Long Dim Directory As String, WorkbookName As String, WorksheetName As String, WorksheetRange As String Dim NamedRangeRefersTo As String On Error GoTo CleanUp ' Check to see if the referenced range is currently open in this Excel instance, ' by using an Evaluate function. If the function returns an error, then the ' range is not open (or the range is invalid). ' Do an EVALUATE on Link to see if the referenced range is currently open in this Excel instance. ' The Evaluate function will return an error if the range is not open LINKEDRANGE = Evaluate(Link) ' If the range is not open (or invalid), an error will be returned from the above statement and ' the following section will be processed If CStr(LINKEDRANGE) = CStr(CVErr(xlErrRef)) Then ' Let's decipher the Directory, WorkbookName, WorksheetName and WorksheetRange from the Link string. ' The Link string can be in a variety of formats. ' If the first character is not a single quote, then a Directory has not been defined. If Left(Link, 1) < "'" Then Exit Function End If ' Remove the leading single quote Link = Mid(Link, 2, Len(Link) - 1) ' the Directory name will end at the last occurrence of "\" ' find last occurrence of "\" iChrPos = InStrRev(Link, "\") Directory = Left(Link, iChrPos) Link = Mid(Link, iChrPos + 1, Len(Link) - iChrPos) ' The next character will be a "[" unless the worksheet name has not been defined (and a workbook-level named range is being used) If Left(Link, 1) = "[" Then ' a worksheet is defined, the Workbook name will be until "]" iChrPos = InStr(Link, "]") WorkbookName = Mid(Link, 2, iChrPos - 2) Link = Mid(Link, iChrPos + 1, Len(Link) - iChrPos) ' the worksheet name will be until a single quote iChrPos = InStr(Link, "'") WorksheetName = Mid(Link, 1, iChrPos - 1) Link = Mid(Link, iChrPos + 2, Len(Link) - iChrPos) Else ' a worksheet is not defined WorksheetName = "" ' the workbook name will be until a single quote iChrPos = InStr(Link, "'") WorkbookName = Mid(Link, 1, iChrPos - 1) Link = Mid(Link, iChrPos + 2, Len(Link) - iChrPos) End If ' the WorksheetRange will be what is left over in the Link string WorksheetRange = Link ' Create a new Excel instance Set xlapp = CreateObject("Excel.Application") ' Open the linked workbook as read-only and do not update any links in the linked workbook. ' If the workbook doesn't exist, an error will be triggered. Set xlwb = xlapp.Workbooks.Open(Directory & WorkbookName, UpdateLinks:=False, ReadOnly:=True) ' If a workbook-level name has been used (i.e. no WorksheetName was specified), then we need to refer ' to the RefersTo property of the named range to ascertain the proper worksheet. If WorksheetName = "" Then ' temporarily add a blank worksheet to avoid problems with worksheet-level named ranges Set xlws = xlwb.Worksheets.Add NamedRangeRefersTo = xlwb.Names(WorksheetRange).RefersTo ' find the '!' in the range iChrPos = InStr(1, NamedRangeRefersTo, "!") WorksheetName = Mid(NamedRangeRefersTo, 2, iChrPos - 2) 'check for single quotes around WorksheetName If Left(WorksheetName, 1) = "'" Then WorksheetName = Mid(WorksheetName, 2, Len(WorksheetName) - 2) End If End If ' Refer to the WorksheetName worksheet. ' If the worksheet doesn't exist, an error will be triggered. Set xlws = xlwb.Worksheets(WorksheetName) ' Refer to the WorksheetRange range on the worksheet. ' If the range doesn't exist or is invalid, an error will be triggered. Set r = xlws.Range(WorksheetRange) LINKEDRANGE = r End If CleanUp: Set xlws = Nothing If Not xlwb Is Nothing Then xlwb.Close 0 Set xlwb = Nothing If Not xlapp Is Nothing Then xlapp.Quit Set xlapp = Nothing End Function '------------------------------------------------- '------------------------------------------------- ' In order to assist with building the 'Link' parameter above (or 'xref' for PULL), ' I created another little UDF below that returns the Link parameter based on ' directory, workbook, worksheet and range inputs. '------------------------------------------------- '------------------------------------------------- Function LINKREFERENCE(Directory As String, WorkbookName As String, WorksheetName As String, WorksheetRange As String) As String ' This function can used as a helper for the LINKEDRANGE function. This function takes in information about the linked range ' and returns a link reference in the form needed by LINKEDRANGE. ' Function Inputs: ' ' Directory - the full path that contains the workbook from which values will be pulled ' - trailing "\" is optional ' - e.g. C:\LinkedData\ ' - relative directories can be used ' - e.g. "C:\DummyDirectory\..\LinkedData\" (evaluates to C:\LinkedData) ' ' WorkbookName - the name of the workbook from which values will be pulled ' - e.g. LinkedWorkbook.xls ' ' WorksheetName - optional - leave blank if referring to a workbook-level named range ' - the name of the worksheet from which values will be pulled ' - e.g. LinkedSheet ' ' WorksheetRange - the cell range or named range from which values will be pulled ' - e.g. A1:E5 ' - e.g. $A$1:$E$5 ' - e.g. LinkedNamedRange ' Function Output: ' LINKEDRANGE - a string that contains the link reference in the form used by LINKEDRANGE Dim sLinkReference As String On Error GoTo CleanUp ' If the Directory, WorkbookName or WorksheetRange fields are not defined, then exit the function immediately. If IsEmpty(Directory) Or IsEmpty(WorkbookName) Or IsEmpty(WorksheetRange) Then Exit Function End If ' Trim the inputs of any excess spaces Directory = Trim(Directory) WorkbookName = Trim(WorkbookName) WorksheetName = Trim(WorksheetName) WorksheetRange = Trim(WorksheetRange) ' check the Directory string and append a '\' to its end if it doesn't already have one If Right(Directory, 1) < "\" Then Directory = Directory & "\" End If ' prefix with a single quote sLinkReference = "'" & Directory ' e.g. 'C:\LinkedData\ ' A worksheet does not need to be specified if using a workbook-level name. ' The format of the 'xref' statement to be evaluated differs if the workbook is not defined. ' Add a "[" if the worksheet name is defined. If WorksheetName < "" Then sLinkReference = sLinkReference & "[" ' e.g. 'C:\LinkedData\[ End If ' Add the workbook name sLinkReference = sLinkReference & WorkbookName ' e.g. 'C:\LinkedData\[LinkedWorkbook.xls ' Add a "]" if the worksheet name is defined If WorksheetName < "" Then sLinkReference = sLinkReference & "]" ' e.g. 'C:\LinkedData\[LinkedWorkbook.xls] End If ' Add the worksheet name (may be blank) sLinkReference = sLinkReference & WorksheetName ' e.g. 'C:\LinkedData\[LinkedWorkbook.xls]LinkedSheet ' Add a single quote and exclamation point sLinkReference = sLinkReference & "'!" ' e.g. 'C:\LinkedData\[LinkedWorkbook.xls]LinkedSheet'! ' Add the linked range (cell range or named range) sLinkReference = sLinkReference & WorksheetRange ' e.g. 'C:\LinkedData\[LinkedWorkbook.xls]LinkedSheet'!A1:E5 LINKREFERENCE = sLinkReference CleanUp: End Function '------------------------------------------------- '------------------------------------------------- ' Finally, here's a small UDF to return the current workbook directory, which can be helpful ' for creating relative links. This is preferable to using the CELL("filename", A1) function ' since CELL("filename") is volatile (even though Microsoft claims it is not!) '------------------------------------------------- '------------------------------------------------- Function ThisWorkbookDirectory() As String ' This function returns the directory of this workbook. Dim sFullName As String Dim iChrPos As Integer, iStrPos As Integer sFullName = ThisWorkbook.FullName ' find last occurrence of "\" iChrPos = InStrRev(sFullName, "\") ThisWorkbookDirectory = Left(sFullName, iChrPos) End Function ------------------------------------------------- I hope that someone finds this helpful! Thanks, Shawn Stackhouse -- ---------------------------------------------- Posted with NewsLeecher v3.0 Final * Binary Usenet Leeching Made Easy * http://www.newsleecher.com/?usenet ---------------------------------------------- |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Using Match function with duplicate values in an array | Excel Worksheet Functions | |||
Links to 2nd closed worksheet fail when using offset function ?? | Excel Worksheet Functions | |||
Excel option to store trendline's coefficients in cells for use | Charts and Charting in Excel | |||
Indirect( ) function loosing values when spreadsheets are closed | Excel Worksheet Functions | |||
copy worksheet from closed workbook to active workbook using vba | Excel Worksheet Functions |