PDA

View Full Version : Need to reference multiple workbooks



cfuqua
07-11-2012, 03:25 PM
Hello,

This may be a basic Excel question, but I have a feeling I need to use some VB. I need to know what's possible.

I have been sent several workbooks. Each workbook contains information about a single item. I need to consolidate the information about many items into a single workbook.

Workbooks are named similar to this:

Workbook001.xls
Workbook002.xls
Workbook003.xls

To reference a cell from another workbook, I use this syntax:

'C:\pathname\001\[Workbook001.xls]Sheet1'!$D$4

But I need to do this with a lot of numbers:

'C:\pathname\002\[Workbook002.xls]Sheet1'!$D$4
'C:\pathname\003\[Workbook003.xls]Sheet1'!$D$4
etc.

Is it possible to automate this process? Furthermore, the numbers I have are not sequential, but they ARE contained in a column in the master workbook. So, something like this:

'C:\pathname\$A1\[Workbook$A1.xls]Sheet1'!$D$4

I've been teaching myself Excel functions over the past few weeks, but it's difficult to find tutorials on linked workbook syntax... help?

cfuqua
07-11-2012, 03:58 PM
A non-elegant method:

="='C:\pathname\"&$A1&"\[Workbook"&$A1&".xls]Sheet1'!$D$4"
Copy
Paste as Values

Then I have to click each one and hit enter to update it, because Calculate Now hasn't worked for me.

Still looking for a better way.

Zack Barresse
07-11-2012, 05:59 PM
Hi there!

You can do this with code fairly easily. If you want to do this one-off at a time, as in you run the code which lets you pick the file, then opens (if necessary, checks in place), grabs the value, puts it in the workbook, closes (if necessary). There are some specifics you should look at changing to fit your needs, such as worksheet names.

Option Explicit

Dim WB As Workbook
Dim WS As Worksheet
Dim wsInput As Worksheet
Dim bFileOpen As Boolean
Dim vName As Variant
Dim sName As String
Dim sPath As String
Dim sFile As String
Dim sFilter As String
Dim iLastRow As Long

Sub GrabValuesFromSingleWorkbook()

sFilter = "Excel File's (*.xls), *.xls"
vName = Application.GetOpenFilename(sFilter)

If TypeName(vName) = "Boolean" Then
'user pressed cancel
Else

sName = Right(vName, VBA.Len(vName) - VBA.InStrRev(vName, Application.PathSeparator))
sPath = VBA.Left(vName, VBA.Len(vName) - VBA.Len(sName))

If ISWBOPEN(sName) = True Then
Set WB = Workbooks(sName)
bFileOpen = True
Else
Set WB = Workbooks.Open(sPath & sName)
bFileOpen = False
End If

Call TOGGLEEVENTS(False)

'/// Set sheet names as desired here
Set WS = WB.Worksheets("Sheet1")
Set wsInput = ThisWorkbook.Worksheets("Sheet1")

iLastRow = wsInput.Cells(wsInput.Rows.Count, "A").End(xlUp).Row
wsInput.Cells(iLastRow + 1, "A").Value = WS.Range("D4").Value

Call TOGGLEEVENTS(True)

If bFileOpen = False Then
WB.Close False
End If

End If

End Sub

Public Sub TOGGLEEVENTS(blnState As Boolean)
Application.DisplayAlerts = blnState
Application.EnableEvents = blnState
Application.ScreenUpdating = blnState
If blnState Then Application.CutCopyMode = False
If blnState Then Application.StatusBar = False
End Sub

Public Function ISWBOPEN(wkbName As String) As Boolean
On Error Resume Next
ISWBOPEN = CBool(Workbooks(wkbName).Name <> "")
On Error GoTo 0
End Function

If, however, you want to process all workbooks in a folder, you can do that as well. Again, look at the code, as you may need to change the specifics, i.e. worksheet names, etc. Right now this is only setup for xls files, but you can change it to whatever you want. I used xls because that is what you used in your examples (same with worksheet names).

Sub GrabValuesFromWorkbooksInAFolder()

vName = BrowseForFolder()

If TypeName(vName) = "Boolean" Then
'user pressed cancel
Else
Call ProcessAll(CStr(vName) & "\")
End If

End Sub

Sub ProcessAll(sPath As String)

'/// Found at: http://www.vbaexpress.com/kb/getarticle.php?kb_id=9
'/// Thanks to Steiner for the code

sFile = Dir(sPath & "*.xls")
'Loop through all .xls-Files in that path

Call TOGGLEEVENTS(False)

Do While sFile <> ""


sName = Right(sFile, VBA.Len(sFile) - VBA.InStrRev(sFile, Application.PathSeparator))

If ISWBOPEN(sName) = True Then
Set WB = Workbooks(sName)
bFileOpen = True
Else
Set WB = Workbooks.Open(sPath & sName)
bFileOpen = False
End If

'/// Set sheet names as desired here
Set WS = WB.Worksheets("Sheet1")
Set wsInput = ThisWorkbook.Worksheets("Sheet1")

iLastRow = wsInput.Cells(wsInput.Rows.Count, "A").End(xlUp).Row

wsInput.Cells(iLastRow + 1, "A").Value = WS.Range("D4").Value

If bFileOpen = False Then
WB.Close False
End If


sFile = Dir
Loop

Call TOGGLEEVENTS(True)

End Sub

Function BrowseForFolder(Optional OpenAt As Variant) As Variant

'/// Found at: http://www.vbaexpress.com/kb/getarticle.php?kb_id=284
'/// Thanks to Ken Puls for the code

'Function purpose: To Browser for a user selected folder.
'If the "OpenAt" path is provided, open the browser at that directory
'NOTE: If invalid, it will open at the Desktop level

Dim ShellApp As Object

'Create a file browser window at the default folder
Set ShellApp = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Please choose a folder", 0, OpenAt)

'Set the folder to that selected. (On error in case cancelled)
On Error Resume Next
BrowseForFolder = ShellApp.self.Path
On Error GoTo 0

'Destroy the Shell Application
Set ShellApp = Nothing

'Check for invalid or non-entries and send to the Invalid error
'handler if found
'Valid selections can begin L: (where L is a letter) or
'\\ (as in \\servername\sharename. All others are invalid
Select Case Mid(BrowseForFolder, 2, 1)
Case Is = ":"
If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
Case Is = "\"
If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
Case Else
GoTo Invalid
End Select

Exit Function

Invalid:
'If it was determined that the selection was invalid, set to False
BrowseForFolder = False

End Function

Please note that when I wrote this code I utilized the variables at the top of the code module outside of any routines. These are shared in that module. If you copy the second set of code above, you'll need the variables in the first code posted (assuming you use Option Explicit - I hope!).

HTH