[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

Find a worksheet within a closed workbook

Posted on 2007-07-26
5
Medium Priority
?
931 Views
Last Modified: 2013-12-26
I am trying to use the following code to get data from a closed workbook and copy it to a sheet in the existing workbook.  In cell B2 a date will be input and based on that date, it should pull the correct worksheet from the closed workbook.  Ex.  If cell B2 = 07/02/2007 change it to a short date (Jul-07) and then find the corresponding worksheet in the closed workbook.  The wb name will be the same but the sheets be named by month and year.  Currently the name of the worksheet don't include the "-" in between the month and year so if that can be excluded, that would be great also.  Here is what I have..

Sub CopyFromClosedWB(strSourceWB As String, _
      strSourceWS As String, strSourceRange As String, _
      rngTarget As Range)
' copies information from a closed workbook, no input validation!
' use like this to copy information to the active worksheet:
' CopyFromClosedWB "C:\test.xls", "wsname", "A1:D100", Range("A1")
Dim wb As Workbook
      Application.ScreenUpdating = False ' turn off the screen updating
      Application.StatusBar = "Copying data from " & strSourceWB & "..."
      On Error Resume Next ' ignore errors
      ' open the source workbook, read only
      Set wb = Workbooks.Open(strSourceWB, True, True)
      On Error GoTo 0 ' stop when errors occur
      If Not wb Is Nothing Then ' opened the workbook
            On Error Resume Next ' ignore errors
            With wb.Worksheets(strSourceWS).Range(strSourceRange)
                  .Copy rngTarget
            End With
            On Error GoTo 0 ' stop when errors occur
            wb.Close False ' close the source workbook without saving changes
            Set wb = Nothing ' free memory
      End If
      Application.StatusBar = False ' reset status bar
      Application.ScreenUpdating = True ' turn on the screen updating
End Sub
Sub TestCopyFromClosedWB()
      CopyFromClosedWB "C:\Workbookname", "Worksheet", "B2:f55", Range("Sheet2!A1")
End Sub

I have it running when cell b2 changes.  If I input the name of the worksheet, Jul 07 it works great but I need it to be based on cell.
0
Comment
Question by:la_pepe59
  • 3
5 Comments
 
LVL 81

Expert Comment

by:zorvek (Kevin Jones)
ID: 19577193
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
0
 
LVL 3

Author Comment

by:la_pepe59
ID: 19577709
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?
0
 
LVL 38

Accepted Solution

by:
jeverist earned 2000 total points
ID: 19579155
Hi la_pepe59,

>  I have it running when cell b2 changes.  If I input the name of the worksheet, Jul 07 it works great but I need it to be based on cell.

Try this:

Sub TestCopyFromClosedWB()
      CopyFromClosedWB "C:\Workbookname", Format(Range("B2"), "mmm-yy"), "B2:f55", Range("Sheet2!A1")
End Sub

Jim
0
 
LVL 81

Expert Comment

by:zorvek (Kevin Jones)
ID: 19579178
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
0
 
LVL 81

Expert Comment

by:zorvek (Kevin Jones)
ID: 19579188
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
0

Featured Post

Upgrade your Question Security!

Add Premium security features to your question to ensure its privacy or anonymity. Learn more about your ability to control Question Security today.

Question has a verified solution.

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

After seeing numerous questions for Dynamic Data Validation I notice that most have used Visual Basic to solve the problem. This suggestion is purely formula based and can be used in multiple rows.
Windows Explorer lets you open cabinet (cab) files like any other folder. In VBA you can easily handle normal files and folders, but opening and indeed creating cabinet files takes a lot more - and that's you'll find here.
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.

834 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