Excel VBA function to get value using variables from closed workbook - excel

I have the following function which I use to fetch data from a closed workbook:
Public Function GetValue(path, file, sheet, ref)
' Retrieves a value from a closed workbook
Dim arg As String
' Make sure the file exists
If Right(path, 1) <> "\" Then path = path & "\"
If Dir(path & file) = "" Then
GetValue = "File Not Found"
Exit Function
End If
' Create the argument
arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
Range(ref).Range("A1").Address(, , xlR1C1)
' Execute an XLM macro
GetValue = ExecuteExcel4Macro(arg)
End Function
Then I have the following test routine which works:
Sub TestGetValue()
p = Range("B2").Value
f = Range("B3").Value
s = "TOTAL"
a = "D" & ActiveCell.Row + 3
MsgBox GetValue(p, f, s, a)
End Sub
However, if I use the GetValue function in an Excel cell providing all 4 parameters exactly like in the routine, it always throws a #VALUE! error.
Why does it work in a routine and not while being called as a function?

After several attempts I did find 3 solutions:
Using a function with "ExecuteExcel4Macro"
Opening the other workbook in the background by vba procedure, then copy/pasting data
Creating external references by vba procedure, then leaving only values
First one while being able to use it as an excel custom formula, it is the slowest, especially when you need data from a specific range. So I don't recommend this option as it would slow your workbook down a lot.
Second option while being much faster, still takes around 15 seconds to get data from several ranges across 2 workbooks.
Third option was the fastest. Like an instant really less than 1 second execution time during which data was pulled from 2 closed workbooks and for different ranges.
Here's the 3rd option's procedure:
Sub getDS()
asname = "data"
bsname = "Anual"
csname = "Total"
filename = Sheets("data").Range("B64").Value
path = Sheets("data").Range("B63").Value
Dim ws As Worksheet
Set ws = Sheets("data")
With ws.Range("D4:D34")
.ClearContents
.Formula = "='" & path & "[" & filename & "]" & bsname & "'!R11"
.Value = .Value
End With
With ws.Range("J4:J34")
.ClearContents
.Formula = "='" & path & "[" & filename & "]" & bsname & "'!U11"
.Value = .Value
End With
With ws.Range("J37:J37")
.ClearContents
.Formula = "='" & path & "[" & filename & "]" & csname & "'!DW96"
.Value = .Value
End With
End Sub
I found this by far to be the BEST and FASTEST VBA solution to fetch data in an INSTANT from closed workbooks (with variables) without opening them.

Related

Product sum with dynamic sheet names in formula

We have a macro that loops through a set of 50 workbooks that have different amounts of sheets. The sheets look similar but all have different sheet names.
We want to place a formula in the first sheet ("Framsida") that searches through column B in sheet 3 to the last sheet to identify how many unique entries there are.
We have been working with PRODUCTSUM and FREQUENCY.
The formula works when pasted into the sheet manually.
When trying this with the macro, it starts linking to other data sources with the error message
"This workbook contains links to other data sources".
The code we tried:
Worksheets("Framsida").Range("m5").Formula = "=SUMPRODUCT(--(FREQUENCY(''" & Sheets(3).Name & " : " & Sheets(Sheets.Count).Name & " '!$B$6:$b$200, ' " & ActiveWorkbook.Sheets(3).Name & " : " & ActiveWorkbook.Sheets(Sheets.Count).Name & " '!$B$6:$b$200)<>0))"
This is the result that comes out in sheet "Framsida" when running the macro:
=PRODUKTSUMMA(--(FREKVENS('8007029 :[ 8007062 ] 8007062 '!$B$6:$B$200; '8007029 :[ 8007062 ] 8007062 '!$B$6:$B$200)<>0))
Where PRODUKTSUMMA=PRODUCTSUM
and FREKVENS=FREQUENCY
It adds the last sheet name in square brackets and we have no idea why. We are open for suggestions to other solutions.
This is the entire loop:
Sub SummeringFramsida()
'Variabler för loopen
Dim MyFile As String
Dim Filepath As String
'-----------------------------------------------------------------------------------'
'Öppnar filer tills det att man kommer till Huvudfilen i listan, filerna som ska sökas måste alltså ligga ovanför i listan'
Filepath = "C:\Users\JohannaFalkenstrand\Desktop\Excelfix\"
MyFile = Dir(Filepath)
Do While Len(MyFile) > 0
If MyFile = "Huvudfil.xlsm" Then
Exit Sub
End If
Workbooks.Open (Filepath & MyFile)
Workbooks(MyFile).Activate
Worksheets("Framsida").Range("m5").Formula = "=SUMPRODUCT(--(FREQUENCY('" & Sheets(3).Name & " : " & Sheets(Sheets.Count).Name & " '!$B$6:$b$200, ' " & ActiveWorkbook.Sheets(3).Name & " : " & ActiveWorkbook.Sheets(Sheets.Count).Name & " '!$B$6:$b$200)<>0))"
'Stänger, sparar och går till nästa fil'
Workbooks(MyFile).Save
Workbooks(MyFile).Close
MyFile = Dir
Loop
End Sub
Give it a try with Range(...).Address(1,1,xlA1,1). This will give you a string of range reference that contains both the workbook and the sheet reference. Then you can compile the required formula with simple string manipulation, like
For Each wb in <SomeCollectionOfWorkbooks>
For Each sh in wb.Sheets
Debug.Print "Copy this to the required cell = SUM(" & _
sh.Range("B6:B200").Address(1,1,xlA1,1) & ")"
Next
Next
The key is the external reference parameter of .Address.
It looks like you want to use same range but on different sheets at same time, so you need to check this out:
Create a reference to the same cell range on multiple
worksheets
Applying this to your code this should kind of work:
Worksheets("Framsida").Range("m5").Formula = "=SUMPRODUCT(--(FREQUENCY(" & Sheets(3).Name & ":" & Sheets(Sheets.Count).Name & "!$B$6:$b$200," & ActiveWorkbook.Sheets(3).Name & ":" & ActiveWorkbook.Sheets(Sheets.Count).Name & "!$B$6:$b$200)<>0))"

VBA: How to get a (more) dynamic file name?

So I have a currently working VBA script. I just want to edit the name by which the loop saves files.
I'll give a quick description of what it is currently doing. Basically it loops a set of actions for a defined range of rows, here A2:A72. The is a 'main' workbook where this loop is done is where all the input data is collected. Each row is a separate subject's input data and is copy/pasted into a template in a different workbook. Solver is then run to adjust the template for the given input data. Then it saves and names file as the text in the first cell of the row that was copy pasted. (ie A2,A3,A4,etc..) It then loops this for every row and every row will have its own template set up and saved separately.
This is ALMOST how I ideally want it to work.
I just want it save the File name not just as A2, but as =C2&" - "&A2
I tried using this that was suggested by someone
fName = Range("C" & c.Row) & Range("A" & c.Row)
But when I tried I would get a Method SaveAs error. On the watch view I could see it was because it wasn't reading the fName so it was just the file path in the script value. I changed it back to c.Value and then it started working by naming the file as the A column cell. Admittedly, I don't really understand how c.Value is returning column A which makes it harder for me to figure out how to modify it to get what I want.
Anyway here is the script as I currently have it:
Sub RunModels()
Dim fPath As String
Dim strTemplate As String
Dim fName As String
Dim wb As Workbook
Dim c As Range
Dim rngLoop As Range
'Where will files get stored?
fPath = "H:\ACQUISITIONS\Personal (D-AP)\Gmo\ALL MF"
'Where is the template file?
strTemplate = "H:\ACQUISITIONS\Personal (D-AP)\Gmo\ALL MF\Garden Grove - 11121 Chapman Ave.xlsm"
'Error check
If Right(fPath, 1) <Application.PathSeparator Then
fPath = fPath & Application.PathSeparator
End If
Application.ScreenUpdating = False
'Set Loop
Set rngLoop = ThisWorkbook.Worksheets("Sheet1").Range("A2:A72")
'Set Looped Actions
For Each c In rngLoop.Cells
'Open the template file
Set wb = Workbooks.Open(strTemplate)
'Add some data to the template file
c.EntireRow.Copy Destination:=wb.Worksheets("Insert
Sheet").Range("A2")
SolverOk SetCell:="$H$20", MaxMinVal:=3, ValueOf:=1.2, ByChange:="$F$35", Engine:=1, EngineDesc:="GRG Nonlinear"
SolverSolve
'Dynamic File Naming
fName = c.Value
'Save the file and close
wb.SaveAs Filename:=wb.Path & Application.PathSeparator & fName
wb.Close
Next c
Application.ScreenUpdating = True
End Sub
Thank you very very much for all and any help!!
You should not use wb.Path wb is assigned to the workbook, where fPath is your folder path, so use:
Filename:=fPath & "\" & fName & ".xlsx"
or ".xlsm" as required.
To assign fName use:
fName = c.Offset(, 2).Value & " - " & c.Value
The code assigns the variable c to each cell in the range A2:A72 in turn - so at the moment it is saving the code 71 times. The code
fName = Range("C" & c.Row) & Range("A" & c.Row)
would produce c2 & A2 on the first time through, and then C3 & A3 on the second (and so on. I suspect you'd like it to always use c2 and then add the value in A - in which case you'd need
Fname = Range("C2") & "- " & c

Consolidating data from multiple excel workbook into master workbook and eliminate duplicate append

I'm stuck in a problem in VBA while consolidating data from other workbook to master work book and using file name and path name is variable which is changing dynamically in loop i searched but i only find hard coded path so i'm posting here following is my code.
Sub Append()
'Append data from other files
Path = "E:\NPM PahseIII\"
Dim c As Range
'find the first empty cell in ColA
Set c = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(2, 0)
Filename = Dir(Path & "*.xlsx")
Do While Filename <> ""
If InStr(Filename, ".") > 0 Then
Filenamenoext = Left(Filename, InStr(Filename, ".") - 1)
End If
c.Value = Filenamenoext
Set c = c.Offset(1, 0)
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
Windows("Master sheet").Activate
Selection.Consolidate Sources:=Array("'Path & [Filename]Sheet1'!$B$2:$B$5"),
Function:=xlSummary
Workbooks(Filename).Close
Filename = Dir()
Loop
End Sub
The first problem is that this program gives me the error
Object doesn't support this property or method
at this line
Selection.Consolidate Sources:=Array("'Path & [Filename]Sheet1'!$B$2:$B$5"),
Function:=xlSummary
secondly i want that when first time data is appended by running the code again if there is no change in the other files data then code should not append duplicate again.
Note that in that string "'Path & [Filename]Sheet1'!$B$2:$B$5" the Path and Filename is not considered as a variable but as a hard coded string!
You must use something like
"'" & Path & "[" & Filename & "]Sheet1'!$B$2:$B$5"
if you want to use the variable values.
Also according to the documentation of the Range.Consolidate method the constant of the xlConsolidationFunction is not Function:=xlSummary but Function:=xlSum.
Also note that Selection is very undefined and can be anywhere in that worksheet. I recommend to read How to avoid using Select in Excel VBA and reference your ranges, workbooks etc without using .Activate and .Select or Selection. at all.

Function for searching via vlookup in closed workbook is not working

I try to do a Vlookup in a closed workbook via ExecuteExcel4Macro. Since I need to find a lot of values in different workbooks it makes sense to do it in a closed workbook.
I used the below code, but it doesn't work if I enter the function on my Excel book:
=GetVlookup("D:", "testfile.xls", "Sheet1", "C1:D8", 2, "CDM-01_10")
I can assure that there is a file on my D: named testfile.xls with a sheet1 and content in the range I mention here. But result is #value!.
I want this in a function since I want to make a price calculation add-in that can be used in several workbooks, so I rather haven't introduced this in a macro.
Public Function GetVlookup(path, file, sheet, ref, Col, vVal)
' Retrieves a value from a closed workbook
Dim arg As String
' Make sure the file exists
If Right(path, 1) <> "\" Then path = path & "\"
If Dir(path & file) = "" Then
GetVlookup = "File Not Found"
Exit Function
End If
If IsNumeric(vVal) Then
vVal = CDbl(vVal)
Else
vVal = Chr(34) & vVal & Chr(34)
End If
' Create the argument
arg = "'" & path & "[" & file & "]" & sheet & "'!" & Range(ref).Address(, , xlR1C1)
' Execute an XLM macro
GetVlookup = ExecuteExcel4Macro("Vlookup(" & vVal & "," & arg & "," & Col & ",0)")
End Function

How to turn this Macro Based function into a genuine VBA function?

I am trying to write a VBA function so that I can access the cell values of a closed Excel Workbook. I found online that one can write a macro routine like this:
Public Sub TestGetValue()
p = "C:\Users\Jake\Desktop"
f = "TestSample.xlsx"
s = "Sheet1"
a = "B10"
Call GetValue(p, f, s, a)
x = GetValue(p, f, s, a)
MsgBox x
End Sub
Public Function GetValue(path, file, sheet, ref)
' Retrieves a value from a closed workbook
Dim arg As String
' Make sure the file exists
If Right(path, 1) <> "\" Then path = path & "\"
If Dir(path & file) = "" Then
GetValue = "File Not Found"
Exit Function
End If
' Create the argument
arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
range(ref).range("A1").Address(, , xlR1C1)
' Execute an XLM macro
GetValue = ExecuteExcel4Macro(arg)
End Function
I can run the TestGetValue() as a macro, but when I try to use GetValue() as a custom VBA function directly in Excel cells it doesn't work. It seems that the line GetValue = ExecuteExcel4Macro(arg) cannot be executed.
Does anyone know how to get around that? I'm using Excel 2010.
As far as I see, the function ExecuteExcel4Macro isn't defined. But there might be an even easier way.
Try to open the Workbook, which contains the desired values. E.g.
Dim tempWb As Workbook
Dim testValue
Set tempWb = Application.Workbooks.Open(path)
testValue = tempWb.Sheets(1).Cells(1,1)
The path can be passed as in your example.

Resources