Function getProductStatus(adr As Range) As String
Dim networkLocation As String, networkPath As String, fileReference As String, srcSheetRef As String, c_formula As String
Dim sheet_src As Worksheet, sheet As Worksheet, wb_src As Workbook, wb As Workbook
Dim sheetName_src As String, sheetName As String
networkLocation = ActiveWorkbook.Path
networkPath = networkLocation & "\Locations\"
sheetName_src = "Sheet1"
sheetName = "Sheet1"
Set wb_src = ThisWorkbook
Set sheet_src = wb_src.Sheets(sheetName_src)
fileReference = networkPath & region_eval & "\ProductList.xlsx"
Workbooks.Open Filename:=fileReference, ReadOnly:=True
Set wb = Workbooks("ProductList.xlsx")
Set sheet = wb.Sheets(sheetName)
c_formula = Application.WorksheetFunction.Index(sheet.Range("$K$2:$K$5000"), Application.WorksheetFunction.Match(sheet_src.Range("A" & adr.Row), sheet.Range("$A$2:$A$5000"), 0))
getProductStatus = c_formula
wb.Close
End Function
The following formula works if entered directly in a cell:
=INDEX('\\..somePath\Locations\[ProductList.xlsx]Sheet1'!$K$2:$K$5000;MATCH('Sheet1'!A2;'\\..somePath\Locations\[ProductList.xlsx]Sheet1'!$A$2:$A$5000;0))
EDIT:
The question was previously about a #NAME error, but that has been resolved.. only to evolve into a worse one.
This function did, at some point, work as intended (after the #NAME was resolved). Between then and now, nothing has changed except closing the file being asked for. And now, opening the file before running the function does nothing.
How can I debug this? Why did Excel stop opening the file?
EDIT #2: The files opened in different instances, apparently, because the function does work if both files are open in the same instance. So the true question is now, why doesn't my code succeed in opening the file "on it's own"?
Related
I try to open a workbook of the type '.xlsm' using
Private Function readFiles(ByVal lv_path As String, ByRef lx_wrkShDes As Worksheet)
'On Error GoTo ErrorHandling
Dim lx_objectExcel As New Excel.Application
Dim lx_wrkBkSrc As Workbook
Dim lx_wrkShSrc As Worksheet
Dim lx_shrPathObj As Object
Dim lv_shrPath As String
Set lx_shrPathObj = CreateObject("scripting.filesystemobject")
lv_shrPath = Replace(lx_shrPathObj.GetFile(lv_path).ShortPath, mv_longFilePathHelper, "")
Set lx_wrkBkSrc = Workbooks.Open(Filename:=lv_shrPath, ReadOnly:=True)
'Using lx_objectExcel.Workbooks.Open WORKS but not Workbooks.Open
'lx_objectExcel.Workbooks.Open(Filename:=lv_shrPath, ReadOnly:=True)
If Not Library.DoesSheetExist(lx_wrkBkSrc, mv_workSheetName) Then
GoTo ErrorHandling
End If
Set lx_wrkShSrc = lx_wrkBkSrc.Sheets(mv_workSheetName)
'Rest of the function
End Function
It opens the workbook and exits the VBA code immediately.
I tried this https://support.microsoft.com/en-us/help/555263, but same results.
It does not exit if I use new instance of Excel using
lx_objectExcel.Workbook.open('path')
I do not want to use a new instance as paste special is not suitable with new instance and opening 100s of Workbooks this way consumes lot of time.
Replace:
Workbook.open('path')
With
Workbooks.Open("PathName")
Referring to the Workbook.Open method, the correct syntax for your action is the following
Workbooks.Open("WorkbookPath")
The following code totally works for me
Dim targetWorkbook As Workbook
Set targetWorkbook = Workbooks.Open("YourWorkbookPath")
You are not using it properly. If this still doesn't work, make sure to send the correct path for your file.
tried this code with 2 xlsm files (MASTER and SLAVE) and it works fine form me. Office 2013
Dim sText As String
Dim objWB As Excel.Workbook
sText = ThisWorkbook.Worksheets("Sheet1").Range("A1").Value
Set objWB = Application.Workbooks.Open(ThisWorkbook.Path & "\SLAVE.XLSM")
objWB.Worksheets("Sheet1").Range("A1").Value = sText
MsgBox "DONE!"
I have some VBA script in one Excel Workbook that has three subs that each either read from a second Workbook. Each of the subs uses the following algorithm (simplified to distill the interaction with the second book):
Public Sub EditRemote()
Dim remoteDataSheet As Worksheet
Dim source As String 'Source worksheet name
Dim target As String 'Target worksheet name
Dim path As String
Dim wkbName As String
source = "CountData"
path = ThisWorkbook.Worksheets("Parameters").Range("B2").Value
wkbName = ThisWorkbook.Worksheets("Parameters").Range("A2").Value
target = "CountData"
Application.EnableCancelKey = xlDisabled
Set localDataSheet = ThisWorkbook.Sheets(source)
If Not WorkbookIsOpen(wkbName) Then
Workbooks.Open (path)
End If
Set remoteDataSheet = Workbooks(wkbName).Sheets(source)
remoteDataSheet.Cells(1,1) = localDataSheet.Cells(1,1)
remoteDataSheet.Cells(1,2) = localDataSheet.Cells(1,2)
Workbooks(wkbName).Close SaveChanges:=True
End Sub
Function WorkbookIsOpen(targetWorkbook As String) As Boolean
Dim testBook As Workbook
On Error Resume Next
Set testBook = Workbooks(targetWorkbook)
If Err.Number = 0 Then
WorkbookIsOpen = True
Else:
WorkbookIsOpen = False
End If
End Function
There is also a pivot table in this Workbook that draws its data from the second file though an external data connection as well. The issue that is plaguing me is that it seems that not initially but after a few operations, these subs stop making the edits properly and instead it opens a read only copy of the second Workbook. When I try to open the second workbook manually I get a message saying that the file is already open and is locked for editing. Right now both files are local to my computer and couldn't be opened by anyone else. What am I missing to be sure that I can make the code work as intended?
I made some modification to your code, ran it a few times, and didn't get your "Read-only" message.
In your code the line of declaring localDataSheet is missing, added Dim localDataSheet As Worksheet , also added Dim remoteWb As Workbook for the remote workbook.
(didn't modify your Funtion WorkbookIsOpen code).
Sub EditRemote Code
Option Explicit
Public Sub EditRemote()
Dim remoteDataSheet As Worksheet
Dim localDataSheet As Worksheet
Dim source As String 'Source worksheet name
Dim target As String 'Target worksheet name
Dim path As String
Dim wkbName As String
Dim remoteWb As Workbook
source = "CountData"
path = ThisWorkbook.Worksheets("Parameters").Range("B2").Value
wkbName = ThisWorkbook.Worksheets("Parameters").Range("A2").Value
target = "CountData"
Application.EnableCancelKey = xlDisabled
Set localDataSheet = ThisWorkbook.Sheets(source)
' check if workbbok already open
If Not WorkbookIsOpen(wkbName) Then
Set remoteWb = Workbooks.Open(path)
Else
Set remoteWb = Workbooks(wkbName) ' workbook is open >> set remoteWb accordingly
End If
Set remoteDataSheet = remoteWb.Sheets(source)
remoteDataSheet.Cells(1, 1) = localDataSheet.Cells(1, 1)
remoteDataSheet.Cells(1, 2) = localDataSheet.Cells(1, 2)
Workbooks(wkbName).Close SaveChanges:=True
End Sub
Just to verify the data in your Excel "Parameters" sheet, the screen-shot below shows the data I used for my testing.
Cell A2 contains the "Clean" workbook name.
Cell B2 contains workbbok "full" name - path + "clean" workbook name.
After some further testing to diagnose the issue, I found that there was nothing wrong with the VBA code, but rather the external data connection to the remote Workbook was locking that Workbook every time I refreshed the data in the pivot table that used the external data connection as its source. It isn't unlocking the file when it is done refreshing, and that leaves the file locked until I close the Workbook with the pivot table. Now I just need to solve that problem.
I am looking for a way to return the value from an arbitrary workbook (the workbook will also not be open at the time of running the UDF), defined based on calculations in the UDF.
Pseudo code:
Start by calling =someFunc(currentCell) in any cell
Function someFunc(adr As Range)
region_eval = "C" & Range(adr).Row ' where column C contains string entries, all of which have a corresponding sub-dir (see fileReference).
networkLocation = ActiveWorkbook.Path
networkPath = networkLocation & "\Locations\"
fileReference = networkPath & region_eval & "\ProductList.xlsx"
Workbook.Open fileReference readonly
Perform index/match call against some sheet in this workbook
someFunc = returned value
Close workbook and end function
This is the desired behavior.
The logic to return the desired values is OK, I have tried it in a simpler formula, and in a UDF that relies on the file being opened manually:
INDEX(locationlist_$A$5000, MATCH(masterlist_A1, locationlist_$B$5000))
I have, after hours of hair-pulling, discovered that this functionality is not directly available in a UDF designed to work on workbooks that aren't opened manually, and that this is intended from Microsoft's side. But I have also discovered that there is a possible workaround!
Ref:
1. https://stackoverflow.com/a/27844592/4604845
2. http://numbermonger.com/2012/02/11/excel-pull-function-creating-dynamic-links-to-closed-workbooks/
These solutions require hardcoded file paths, which defeats the purpose for my intended usage.
Is there anyone who has insight about how to achieve what is achieved in any of the two above links, but with an arbitrary filepath (as in, contained in a cell neighbouring the cell where the UDF is being called from)?
Note: I tried doing the heavy lifting in a sub, and just call the sub as the first line in the UDF, set the result as a global var, and set the UDF return value to the same var after the sub finished, but either I crashed and burned pretty heavily or Excel saw through my trick and denied it.
EDIT:
Here's the sub/func combo.
Option Explicit
Public networkLocation As String, networkPath As String, fileReference As String, c_formula As String
Public sheet_src As Worksheet, sheet As Worksheet, wb_src As Workbook, wb As Workbook
Public region_eval As String, sheetName_src As String, sheetName As String, regionPath As String, fileName As String
Sub findProductStatus(adr As Range)
networkLocation = ActiveWorkbook.Path
networkPath = networkLocation & "\Locations\"
sheetName_src = "Sheet1"
sheetName = "Sheet1"
Set wb_src = ThisWorkbook
Set sheet_src = wb_src.Sheets(sheetName_src)
region_eval = Range("I" & adr.Row)
regionPath = networkPath & region_eval
'fileReference = regionPath & "\ProductList.xlsx"
fileName = "ProductList.xlsx"
ChDir regionPath
Workbooks.Open fileName:=fileName, ReadOnly:=True
'Set wb = Workbooks.Open(fileName:=ThisWorkbook.Path & "\Locations\Test\ProductList.xlsx", ReadOnly:=True)
Set wb = Workbooks("ProductList.xlsx")
Set sheet = wb.Sheets(sheetName)
c_formula = Application.WorksheetFunction.Index(sheet.Range("$K$2:$K$5000"), Application.WorksheetFunction.Match(sheet_src.Range("A" & adr.Row), sheet.Range("$A$2:$A$5000"), 0))
End Sub
Function getProductStatus(adr As Range) As String
Call findCourseStatus(adr)
getCourseStatus = c_formula
wb.Close
End Function
I haven't tested the sub/func combo against an open file, but when all of the code was inside the Function and the file in question was opened manually, it worked flawlessly. Stepping through the code and using Debug.Print, I see that even though "Workbooks.Open ..." goes through without any discernible error, the workbook doesn't actually get opened, and thus, when we try to use the workbook object to set the sheet, the function/sub terminates.
This can be achieved with a combination of a UDF() and an Event macro.
To retrieve data from a closed workbook, we need four things:
the path
the filename
the sheetname
the cell address
The only thing the UDF will do is to display these items in a very specific format:
Public Function someFunc() As String
Dim wbPath As String, wbName As String
Dim wsName As String, CellRef As String
Dim Ret As String
wbPath = "C:\TestFolder\"
wbName = "ABC.xls"
wsName = "xxx"
CellRef = "B9"
someFunc = "'" & wbPath & "[" & wbName & "]" & _
wsName & "'!" & Range(CellRef).Address(True, True, -4150)
End Function
Take note of the position of the single quotes.
We then use a Calculate event macro to detect the UDF's execution and retrieve the data:
Private Sub Worksheet_Calculate()
Dim r1 As Range, r2 As Range
Set r1 = Range("C3")
Set r2 = Range("C4")
r2.Value = ExecuteExcel4Macro(r1.Value)
End Sub
The Calculate macro needs to know where the UDF is returning the string (C3) and it also needs to know where to put the retrieved data (C4).
I want to open and refer to a workbook via the function below. Only the function produces the run-time error '91': object variable or with block variable not set just before jumping back into the main code.
When I put the exact code (just not as function) into my main code it works perfectly.
But I don't want to have the whole function in my main code because I think it's unnecessary and ugly.
Maybe someone can help me make my code nicer and better comprehensible!
Thank you already!
This is the relevant part of my main sub:
Sub main_sub()
Dim WBtest As Workbook
Dim WBpath As String
WBpath = ThisWorkbook.Sheets("Control").Range("A6").Value 'read path
WBtest = openfile(WBpath) 'I call my function here
End Sub
This is the function that produces the error
The function is supposed to return the (newly) opened workbook
Public Function openfile(path As String) As Workbook 'path is fullpath
Dim wb As Workbook
Dim alreadyopen As Boolean
For Each wb In Workbooks 'loop over all Workbooks
If wb.FullName = path Then 'check if file is already open
alreadyopen = True
Set openfile = wb
End If
Next wb
If alreadyopen = False Then
'file not yet opened --> open it
Set openfile = Workbooks.Open(path)
End If
'MsgBox openfile.name 'this returns the right name
End Function
When I write all of it in my main sub it works (but is ugly, so I don't want it there!)
This works:
Sub main_sub()
Dim WBtest As Workbook
Dim WBpath As String
Dim wb As Workbook 'for loop
Dim alreadyopen As Boolean
WBpath = ThisWorkbook.Sheets("Control").Range("A6").Value 'read path
For Each wb In Workbooks 'loop over all Workbooks
If wb.FullName = WBpath Then
alreadyopen = True
Set WBtest = wb
End If
Next wb
If alreadyopen = False Then
'file not yet opened --> open it
Set WBtest = Workbooks.Open(WBpath)
End If
End Sub
I have a similar problem later in my code, where I want to have a function return a workbook, too. So this seems to be the problem.
How does a function return a workbook?
I have found similar functions returnins worksheets. Those work. Why not with workbooks?
Thank you so much for your help!
The different between both approaches is that, in the first one, you are forgetting the Set bit. Thus, solution:
Set WBtest = openfile(WBpath) 'I call my function here
I want to collect data from different files and insert it into a workbook doing something like this.
Do While THAT_DIFFERENT_FILE_SOMEWHERE_ON_MY_HDD.Cells(Rand, 1).Value <> "" And Rand < 65536
then 'I will search if the last row in my main worksheet is in this file...
End Loop
If the last row from my main worksheet is in the file, I'll quit the While Loop. If not, I'll copy everything. I'm having trouble finding the right algorithm for this.
My problem is that I don't know how to access different workbooks.
The best (and easiest) way to copy data from a workbook to another is to use the object model of Excel.
Option Explicit
Sub test()
Dim wb As Workbook, wb2 As Workbook
Dim ws As Worksheet
Dim vFile As Variant
'Set source workbook
Set wb = ActiveWorkbook
'Open the target workbook
vFile = Application.GetOpenFilename("Excel-files,*.xls", _
1, "Select One File To Open", , False)
'if the user didn't select a file, exit sub
If TypeName(vFile) = "Boolean" Then Exit Sub
Workbooks.Open vFile
'Set targetworkbook
Set wb2 = ActiveWorkbook
'For instance, copy data from a range in the first workbook to another range in the other workbook
wb2.Worksheets("Sheet2").Range("C3:D4").Value = wb.Worksheets("Sheet1").Range("A1:B2").Value
End Sub
You might like the function GetInfoFromClosedFile()
Edit: Since the above link does not seem to work anymore, I am adding alternate link 1 and alternate link 2 + code:
Private Function GetInfoFromClosedFile(ByVal wbPath As String, _
wbName As String, wsName As String, cellRef As String) As Variant
Dim arg As String
GetInfoFromClosedFile = ""
If Right(wbPath, 1) <> "" Then wbPath = wbPath & ""
If Dir(wbPath & "" & wbName) = "" Then Exit Function
arg = "'" & wbPath & "[" & wbName & "]" & _
wsName & "'!" & Range(cellRef).Address(True, True, xlR1C1)
On Error Resume Next
GetInfoFromClosedFile = ExecuteExcel4Macro(arg)
End Function
Are you looking for the syntax to open them:
Dim wkbk As Workbook
Set wkbk = Workbooks.Open("C:\MyDirectory\mysheet.xlsx")
Then, you can use wkbk.Sheets(1).Range("3:3") (or whatever you need)
There's very little reason not to open multiple workbooks in Excel. Key lines of code are:
Application.EnableEvents = False
Application.ScreenUpdating = False
...then you won't see anything whilst the code runs, and no code will run that is associated with the opening of the second workbook. Then there are...
Application.DisplayAlerts = False
Application.Calculation = xlManual
...so as to stop you getting pop-up messages associated with the content of the second file, and to avoid any slow re-calculations. Ensure you set back to True/xlAutomatic at end of your programming
If opening the second workbook is not going to cause performance issues, you may as well do it. In fact, having the second workbook open will make it very beneficial when attempting to debug your code if some of the secondary files do not conform to the expected format
Here is some expert guidance on using multiple Excel files that gives an overview of the different methods available for referencing data
An extension question would be how to cycle through multiple files contained in the same folder. You can use the Windows folder picker using:
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
If .Selected.Items.Count = 1 the InputFolder = .SelectedItems(1)
End With
FName = VBA.Dir(InputFolder)
Do While FName <> ""
'''Do function here
FName = VBA.Dir()
Loop
Hopefully some of the above will be of use
I had the same question but applying the provided solutions changed the file to write in. Once I selected the new excel file, I was also writing in that file and not in my original file. My solution for this issue is below:
Sub GetData()
Dim excelapp As Application
Dim source As Workbook
Dim srcSH1 As Worksheet
Dim sh As Worksheet
Dim path As String
Dim nmr As Long
Dim i As Long
nmr = 20
Set excelapp = New Application
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.Filters.Add "Excel Files", "*.xlsx; *.xlsm; *.xls; *.xlsb", 1
.Show
path = .SelectedItems.Item(1)
End With
Set source = excelapp.Workbooks.Open(path)
Set srcSH1 = source.Worksheets("Sheet1")
Set sh = Sheets("Sheet1")
For i = 1 To nmr
sh.Cells(i, "A").Value = srcSH1.Cells(i, "A").Value
Next i
End Sub
With excelapp a new application will be called. The with block sets the path for the external file. Finally, I set the external Workbook with source and srcSH1 as a Worksheet within the external sheet.