Find a worksheet within a closed workbook

Add the code below to a general module. To read cells from a closed workbook, select the destination cells in the destination worksheet and enter a formula like:

   =GetCellsFromClosedWorkbook("C:\", "Workbookname", "Worksheet", "B2:F55")

and press CTRL+SHIFT+ENTER.

-----

Public Function GetCellsFromClosedWorkbook( _
      ByVal WorkbookPath As String, _
      ByVal WorkbookName As String, _
      ByVal WorksheetName As String, _
      ByVal SourceReference As String, _
      Optional ByVal FirstRow As Long = 1, _
      Optional ByVal FirstColumn As Long = 1 _
   ) As Variant

' Read cell values from a closed workbook. The closed workbook cannot be
' password protected.
'
' Syntax
'
' WorkbookPath - The full path to the folder containing the workbook.
'
' WorkbookName - The workbook name including the file extension.
'
' WorksheetName - The name of the worksheet from which to pull the value.
'
' CellReference - A string containing the cell address in A1 reference style.
'   The reference can be any size.
'
' FirstRow - The base row from which to offset CellReference. If the source
'   workbook's used range starts in a row other than 1, use this parameter to
'   tell the function on what row the used range starts. Optional. If omitted
'   then 1 is assumed.
'
' FirstColumn - The base column from which to offset CellReference. If the
'   source workbook's used range starts in a column other than 1, use this
'   parameter to tell the function on what column the used range starts.
'   Optional. If omitted then 1 is assumed.
'
' Notes
'
' The reason FirstRow and FirstColumn are required is because, when using ADO
' to open a worksheet, the first field in the first record is the top left cell
' in the used range which may or may not be cell A1.

   Dim Result As Variant
   Dim Error As Variant
   Dim Connection As Object
   Dim RecordSet As Object
   Dim SourceReferenceRange As Range
   Dim SQL As String
   Dim FirstRecordSetRow As Long
   Dim FirstRecordSetColumn As Long
   Dim Rows As Long
   Dim Columns As Long
   Dim ResultRows As Long
   Dim ResultColumns As Long
   Dim ValueRows As Long
   Dim ValueColumns As Long
   Dim Row As Long
   Dim Column As Long
   Dim ErrorNumber As Long
 
   ' Append trailing slash
   If Right(WorkbookPath, 1) <> "\" Then WorkbookPath = WorkbookPath & "\"
   
   ' Check for valid path name
   If Len(Dir(WorkbookPath & WorkbookName)) = 0 Then
      Error = "#Bad Path or File!"
      GoTo GetCellsFromClosedWorkbook_Exit
   End If
   
   ' Check for valid range reference
   On Error Resume Next
   Set SourceReferenceRange = Range(SourceReference)
   On Error GoTo 0
   If SourceReferenceRange Is Nothing Then
      Error = "#Invalid Reference!"
      GoTo GetCellsFromClosedWorkbook_Exit
   End If
   
   ' Open the ADODB connection and record set
   Set Connection = CreateObject("ADODB.Connection")
   With Connection
      .Provider = "Microsoft.Jet.OLEDB.4.0"
      .Properties("Extended Properties") = "Excel 8.0;HDR=NO;IMEX=1"
      .Open WorkbookPath & WorkbookName
   End With
   Set RecordSet = CreateObject("ADODB.Recordset")
   On Error Resume Next
   RecordSet.Open "SELECT * From [" & WorksheetName & "$]", Connection, 1, 1 ' adOpenKeyset, adLockReadOnly
   ErrorNumber = Err.Number
   On Error GoTo 0
   If ErrorNumber <> 0 Then
      Error = "#Worksheet Not Found!"
      GoTo GetCellsFromClosedWorkbook_Exit
   End If
   
   FirstRecordSetRow = SourceReferenceRange.Row - FirstRow + 1
   Rows = Application.Min(RecordSet.RecordCount - FirstRecordSetRow + 1, SourceReferenceRange.Rows.Count)
   FirstRecordSetColumn = SourceReferenceRange.Column - FirstColumn + 1
   Columns = Application.Min(RecordSet.Fields.Count - FirstRecordSetColumn + 1, SourceReferenceRange.Columns.Count)
   
   ' Set up and initialize result
   If TypeName(Application.Caller) = "Range" Then
      ResultRows = Application.Caller.Rows.Count
      ResultColumns = Application.Caller.Columns.Count
   Else
      ResultRows = Rows
      ResultColumns = Columns
   End If
   ValueRows = ResultRows
   ValueColumns = ResultColumns
   If Rows > ValueRows And Not Columns > ValueColumns Then
      ValueRows = Application.Max(ValueRows - 1, 1)
   ElseIf Not Rows > ValueRows And Columns > ValueColumns Then
      ValueColumns = Application.Max(ValueColumns - 1, 1)
   End If
   ReDim Result(1 To ResultRows, 1 To ResultColumns)
   For Column = 1 To ResultColumns
      For Row = 1 To ResultRows
         Result(Row, Column) = vbNullString
      Next Row
   Next Column
   
   ' Check range
   If FirstRecordSetColumn < 1 Or FirstRecordSetRow < 0 Or Rows < 1 Or Columns < 1 Then
      Error = "#Bad Reference!"
      GoTo GetCellsFromClosedWorkbook_Exit
   End If
   
   ' Pull the cell values from the record set
   If FirstRecordSetRow > 1 Then RecordSet.Move FirstRow
   Row = 1
   For Row = 1 To Application.Min(ValueRows, Rows)
      For Column = 1 To Application.Min(ValueColumns, Columns)
         If Not IsNull(RecordSet.Fields(FirstRecordSetColumn + Column - 2)) Then
            Result(Row, Column) = RecordSet.Fields(FirstRecordSetColumn + Column - 2)
         End If
      Next Column
      RecordSet.MoveNext
   Next Row

GetCellsFromClosedWorkbook_Exit:

   ' Return the result
   If IsEmpty(Result) Then
      If TypeName(Application.Caller) = "Range" Then
         ResultRows = Application.Caller.Rows.Count
         ResultColumns = Application.Caller.Columns.Count
         ReDim Result(1 To ResultRows, 1 To ResultColumns)
         For Column = 1 To ResultColumns
            For Row = 1 To ResultRows
               Result(Row, Column) = vbNullString
            Next Row
         Next Column
      Else
         ResultRows = 1
         ResultColumns = 1
         ReDim Result(1 To 1, 1 To 1)
      End If
   Else
      If TypeName(Application.Caller) = "Range" Then
         If Rows > ResultRows And Columns > ResultColumns Then
            Result(ResultRows, ResultColumns) = "More..."
         Else
            If Rows > ResultRows Then
               Result(ResultRows, 1) = "More..."
            ElseIf Columns > ResultColumns Then
               Result(1, ResultColumns) = "More..."
            End If
         End If
      End If
   End If
   If Not IsEmpty(Error) Then Result(1, 1) = Error
   If ResultRows = 1 And ResultColumns = 1 Then
      GetCellsFromClosedWorkbook = Result(1, 1)
   Else
      GetCellsFromClosedWorkbook = Result
   End If
   
   ' Clean up
   On Error Resume Next
   RecordSet.Close
   Connection.Close

End Function

Kevin

Thanks for the quick response.  If I do it this way, I was rearranging some of the data with a cut and paste so I could do a hlookup and pull some data into sheet1.  It wont allow me to do that as it says I can't change an array.  

Second,  maybe i missed it but I don't see where it is using the cell contents of b2 and changing it into a short date and pulling the corresponding sheet within the closed workbook.  Is it possible to use the code I currently have and get it to look at the contents of "b2" and do the above with it?

Here is the formula to use with the UDF above:

   =GetCellsFromClosedWorkbook("C:\", "Workbookname", TEXT(B2, "mmm-yy"), "B2:F55")

Also, you can break the pulls up into smaller chunks and place them anywhere you want. All you need to do is select the right size range and use the appropriate formula.

Kevin

For example, suppose you wanted to pull in specific columns. Select the column of cells to receive the first column of pulled data and use this formula:

   =GetCellsFromClosedWorkbook("C:\", "Workbookname", TEXT(B2, "mmm-yy"), "B2:B55")

Select another column for the second pulled column and use this formula:

   =GetCellsFromClosedWorkbook("C:\", "Workbookname", TEXT(B2, "mmm-yy"), "C2:C55")

and so on.

Kevin