Copy paste from closed workbook using VBA in Excel - excel

I have 2 workbooks: "reportPageImpression.xlsx" and "testCloseWorkbook.xslx". Currently I am able to get data from reportPageImpression to testCloseWorkbook when clicking the "Update" button.
What I try to do is when clicking again the "Update" button, the value will go to "Jan-16" (new column) and so on. Here's my code:
Option Explicit
Private Function GetValueFromClosedWorkbook(path, file, sheet, ref)
Dim arg As String
'Let’s check whether the file exists
If Right(path, 1) <> "\" Then path = path & "\"
If Dir(path & file) = "" Then
GetValueFromClosedWorkbook = "File Not Found"
Exit Function
End If
'We create the argument
arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
Range(ref).Range("A1").Address(, , xlR1C1)
'MsgBox arg
'Now we execute an XLM macro
'All references must be given as R1C1 strings.
GetValueFromClosedWorkbook = ExecuteExcel4Macro(arg)
End Function
Sub TestGetValueFromClosedWorkbook()
Dim p As String, f As String
Dim s As String, a As String
p = ThisWorkbook.path
f = "reportPageImpression.xlsx"
s = "report_page_impression"
a = "D39"
ActiveSheet.Range("C8") = GetValueFromClosedWorkbook(p, f, s, a)
End Sub

ActiveSheet.Cells(Range("C8").Row, Columns.Count).End(xlToLeft).Offset(0, 1) = GetValueFromClosedWorkbook(p, f, s, a)
to check for a cell to be empty you must use a formula like "COUNTA(range)" as the argument of the ExecuteExcel4Macro(arg) method and get back the number of non empty cells in the closed workbook specified range.
If you specify your cell address as its range and it returns zero then that cell is empty otherwise it has a value and then you can use ExecuteExcel4Macro(arg) method again with the cell reference as its argument. In this latter case you may want to use .Offset(rowOffset) method on your original "Range" to shift to a cell rowOffset rows apart from it.
In order not to get lost in references, I'd suggest you to refactor your code and make extensive use of "wrappers" in order to have clean an maintanable code
Here you may find what I've come up to as per my understanding
Sub TestGetValueFromClosedWorkbook()
Dim p As String, f As String
Dim s As String, a As String
Dim argPart As String
Dim var As Variant
Dim checkSheetResult As String
p = ThisWorkbook.path
f = "reportPageImpression.xlsx"
s = "report_page_impression"
a = "D39"
checkSheetResult = CheckSht(p, f) ' check if the file to be read as closed is not already opened and if it exists
If checkSheetResult = "" Then
argPart = "'" & p & "[" & f & "]" & s & "'!" 'set the "constant" part of the argument
var = GetFirstNonEmptyValueFromClosedWorkbook(a, argPart, -1)
If var = -1 Then
MsgBox ("No value found!")
Else
ActiveSheet.Cells(Range("C8").row, Columns.Count).End(xlToLeft).Offset(0, 1) = var
End If
Else
MsgBox checkSheetResult
End If
End Sub
Private Function GetFirstNonEmptyValueFromClosedWorkbook(ref As String, argPart As String, Optional rowOffsetRate As Variant) As Variant
Dim arg As String, funcArg As String
Dim var As Variant
Dim rowOffset As Long
If IsMissing(rowOffsetRate) Then rowOffsetRate = 0
rowOffset = 0
funcArg = SetArgFunction(ref, argPart, rowOffset, arg)
var = ExecuteExcel4Macro(funcArg)
Do While var = -1 And CheckIfOffset(ref, CLng(rowOffsetRate), rowOffset)
funcArg = SetArgFunction(ref, argPart, rowOffset, arg)
var = ExecuteExcel4Macro(funcArg)
Loop
If var <> -1 Then var = ExecuteExcel4Macro(arg)
GetFirstNonEmptyValueFromClosedWorkbook = var
End Function
Private Function SetArgFunction(ref As String, argPart As String, rowOffset As Long, arg As String) As String
arg = argPart & Range(ref).Range("A1").Offset(rowOffset).Address(, , xlR1C1)
SetArgFunction = "IF(COUNTA(" & arg & ")>0,1,-1)"
End Function
Private Function CheckIfOffset(ref As String, rowOffsetRate As Long, rowOffset As Long) As Boolean
Dim nextRow As Long
Dim cell As Range
Set cell = Range(ref)
nextRow = cell.Offset(rowOffset).row + rowOffsetRate
CheckIfOffset = rowOffsetRate > 0 And nextRow <= cell.Parent.Cells(cell.Parent.Rows.Count, 1).row _
Or (rowOffsetRate < 0 And nextRow > 0)
If CheckIfOffset Then rowOffset = rowOffset + rowOffsetRate
End Function
Private Function CheckSht(path As String, file As String) As String
Dim wb As Workbook
Dim okSheet As Boolean
If Right(path, 1) <> "\" Then path = path & "\"
On Error Resume Next
Set wb = Workbooks(file)
On Error GoTo 0
okSheet = wb Is Nothing
If Not okSheet Then okSheet = wb.path & "\" <> path
If Not okSheet Then
' file is already open
CheckSht = "workbook:" & vbCrLf & vbCrLf & file & vbCrLf & vbCrLf & "in:" & vbCrLf & vbCrLf & path & vbCrLf & vbCrLf & "is already open!"
Else
'Let’s check whether the file exists
If Dir(path & file) = "" Then CheckSht = "workbook:" & vbCrLf & vbCrLf & file & vbCrLf & vbCrLf & "in:" & vbCrLf & vbCrLf & path & vbCrLf & vbCrLf & "not found!"
End If
End Function
the "logic" of shifting to a different cell is all in var = GetFirstNonEmptyValueFromClosedWorkbook(a, argPart, -1) where that -1 is the "rowOffsetRate" that GetFirstNonEmptyValueFromClosedWorkbook(ref As String, argPart As String, Optional rowOffsetRate As Variant) As Variantfunction takes into account if the cell in address a is empty. if no "rowOffsetRate" is passed then it only checks the cell in address a

Related

Getting Cell Value from Closed Workbooks in a Directory - How to Loop Through All Existing Files?

I have a working code to retrieve a specific cell in a closed workbook when I specify the directory. I'm trying to get this code to loop through all the existing workbooks in said directory, retrieving the same cell from each file.
This is the code I have so far with the loop (I'm including the function used as well):
Private Function GetValueFromClosedWorkbook(path, file, sheet, ref)
Dim arg As String, xFolder As String
If Right(path, 1) <> "\" Then path = path & "\"
If Dir(path & file) = "" Then
GetValueFromClosedWorkbook = "File not found."
Exit Function
End If
arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
Range(ref).Address(, , xlR1C1) 'create the argument
GetValueFromClosedWorkbook = ExecuteExcel4Macro(arg)
End Function
Sub TestGetValueFromClosedWorkbook()
Dim p As String, xFolder As String
Dim s As String, a As String, f(1 To 2) As String, z As Long
xFolder = "\\generic path"
For z = 1 To 2
s = "Sheet1"
a = "A1"
p = xFolder '& "\*.xlsx"
f(z) = Dir(p & "\*.xlsx")
Do While f(z) <> ""
ActiveSheet.Range("A" & (z + 7)) = GetValueFromClosedWorkbook(p, f(z), s, a)
f(z) = Dir()
Loop
Next z
End Sub
This gets the correct cell, and then pastes in the active worksheet in cell A8.
The only issue is that when it loops through the second file, it still gets the cell from the first file. Why is that happening? Or how can I ensure that the second loop it retrieves the cell from the second workbook?
The loops were a bit messed up, and you were overwriting the values. Please see below corrected code:
Sub TestGetValueFromClosedWorkbook()
Dim p As String, xFolder As String
Dim s As String, a As String, f As String, z As Long
xFolder = "\\generic path"
s = "Sheet1"
a = "A1"
p = xFolder '& "\*.xlsx"
f = Dir(p & "\*.xlsx")
Do While f <> ""
ActiveSheet.Range("A" & (z + 7)) = GetValueFromClosedWorkbook(p, f, s, a)
f = Dir()
z = z + 1
Loop
End Sub

Retrieve last value in a row of a specific column of multiple closed workbooks without opening

I have a list of files in a worksheet, that are files in a subfolder of the current directory.
I need to retrieve the value of a specific cell (can change), in a specific sheet (constant).
Of 10 files that are in the subfolder and which all have a sheet called "resumen", I want to get the value of the last row in column G.
So far I have this
Sub read_data_from_file_WO_openning()
Dim outputs_address As String
Dim FolderName As String, wbName As String, cValue As Variant
outputs_address = Sheets("lista_macro").Range("G2").Value
ruta_csv_output = ActiveWorkbook.Path & outputs_address
FolderName = ruta_csv_output
'select files to review
For Each file_analysis In Sheets("archivos_en_outputs").Range("I2", Range("I2").End(xlDown))
wbName = file_analysis.Value
cValue = GetInfoFromClosedFile2(FolderName, wbName, "resumen", "G1")
MsgBox (file_analysis & cValue) 'to see the values
Next file_analysis
End Sub
Private Function GetInfoFromClosedFile2(ByVal wbPath As String, _
wbName As String, wsName As String, cellRef As String) As Variant
Dim arg As String
If Right(wbPath, 1) <> "\" Then wbPath = wbPath & "\"
arg = "'" & wbPath & "[" & wbName & "]" & _
wsName & "'!" & Range(cellRef).Address(True, True, xlR1C1)
GetInfoFromClosedFile2 = ExecuteExcel4Macro(arg)
End Function
In range I2 to down I have my list of files.
The problem is that my "G1" only retrieves data of cell G1 of all files, and I need the last row of column G for each file.
Sometimes these files have 7 rows, others have 15. The number of rows can change but always is at least 2.
I know the problem is in cell reference, but I don't know how to change this to accomplish what I have said.
Assuming that there are no blank spaces in Column G, you can use ExecuteExcel4Macro with the WorksheetFunction CountA to find the last row.
Function getLastValueInColumnG(ByVal wbPath As String, wbName As String, wsName As String) As Variant
Dim count As Long
Dim Address As String
Address = getExternalR1C1Address(wbPath, wbName, wsName, "G:G")
count = ExecuteExcel4Macro("CountA(" & Address & ")")
Address = getExternalR1C1Address(wbPath, wbName, wsName, "G" & count)
getLastValueInColumnG = ExecuteExcel4Macro(Address)
End Function
Function getExternalR1C1Address(ByVal wbPath As String, wbName As String, wsName As String, cellRef As String) As String
If Right(wbPath, 1) <> "\" Then wbPath = wbPath & "\"
getExternalR1C1Address = "'" & wbPath & "[" & wbName & "]" & wsName & "'!" & Range(cellRef).Address(True, True, xlR1C1)
End Function
Another approach assuming you have limited number of rows in your output files (<1000 ?)
Option Explicit
Sub find_in_closed_files()
Application.ScreenUpdating = False
Dim Fch As Range
Dim Wb1 As Workbook: Set Wb1 = ActiveWorkbook
Dim Fld As String: Fld = Wb1.Path & Sheets("lista_macro").Range("G2").Value
If Not Right(Fld, 1) = "\" Then Fld = Fld & "\"
Dim Ws1 As Worksheet: Set Ws1 = Wb1.Sheets(1)
Dim Ws2 As Worksheet: Set Ws2 = Wb1.Sheets("tmp pull") 'This is a temp draft sheet to pull the data that you'll need to create
For Each Fch In Ws1.Range("I2", Ws1.Range("I2").End(xlDown))
Ws2.Cells.Clear
Ws2.Range("G1:G999").FormulaR1C1 = "=IF('" & Fld & "[" & Fch.Value & "]resumen'!RC<>"""",'" & Fld & "[" & Fch.Value & "]resumen'!RC,"""")"
Ws2.Range("G1:G999").Value2 = Ws2.Range("G1:G999").Value2
MsgBox Ws2.Range("G9999").End(xlUp).Value
Next Fch
Application.ScreenUpdating = True
End Sub
This leaves a formula in column G that will track the last text, number or date in column G of the resumen worksheet within the closed external workbooks.
Sub xlsxLastG()
Dim i As Long, f As String
With Worksheets("archivos_en_outputs")
For i = 2 To .Cells(.Rows.Count, "I").End(xlUp).Row
'conform C:\Users\public\AppData\Documents\test.xlsb
' to 'C:\Users\public\AppData\Documents\[test.xlsb]resumen'!G:G
f = .Cells(i, "I").Value
f = Left(f, InStrRev(f, Chr(92))) & Chr(91) & Right(f, Len(f) - InStrRev(f, Chr(92)))
f = Chr(39) & f & Chr(93) & "resumen'!G:G"
.Cells(i, "G").Formula = _
"=index(" & f & ", max(iferror(match(1e99, " & f & "), 0), iferror(match(""zzz"", " & f & "), 0)))"
Next i
End With
End Sub
#N/A errors would typically mean column G was blank; #REF! errors would indicate not existing workbook or no resumen worksheet within the referenced workbook.

Run-Time Error 1004 When Using Vlookup with ExecuteExcel4Macro

How do you properly construct a VLOOKUP statement in Excel VBA when using the ExecuteExcel4Macro function in VBA?
I have a function that successfully looks up a value in another excel workbook without opening it using ExecuteExcel4Macro, but when I attempt to change the statement to a VLOOKUP statement I get a Run-time error 1004:
The function:
Public Function fGetValueTest(sFilePath, sFileName, sSourceSheet, sSourceCell, vVal, Col)
'Returns the value of a cell from a closed file [BD]
'Declaring variables [BD]
Dim sStringMacro As String
Dim externalValue As Variant
'Setting variables [BD]
externalValue = ExecuteExcel4Macro("'" & sFilePath & "[" & sFileName & "]" & sSourceSheet & "'!" & _
Range("A1").Range(sSourceCell).Address(, , xlR1C1))
'Exception error on file not found [BD]
If Dir(sFilePath & sFileName) = "" Then
fGetValueTest = "File Not Found!"
Exit Function
End If
'If value of source cell is N/A [BD]:
If Application.IsNA(externalValue) Then
'Skip and move on [BD]
fGetValueTest = "0"
ElseIf IsError(externalValue) Then
MsgBox "Error - Check fGetValue Function"
Else
'Creating macro variable [BD]
sStringMacro = "'" & sFilePath & "[" & sFileName & "]" & sSourceSheet & "'!" & _
Range("A1").Range(sSourceCell).Address(, , xlR1C1)
fGetValueTest = ExecuteExcel4Macro("Vlookup(" & vVal & "," & sStringMacro & "," & Col & ",0)")
End If
End Function
And it's usage in the subroutine:
Sub TestGetValue()
Dim sFileName As String
Dim sFilePath As String
Dim sSourceSheet As String
Dim sSourceCell As String
Dim sDestinationCell As String
Dim sDestinationSheet As String
Dim vVal As String
Dim Col As String
sFileName = "0306-0312 Margin Master.xlsx"
sFilePath = "\\store\GroupDrives\Pricing\_Deli_\Deli Fresh Shift\Margin Master\"
sSourceSheet = "Bakery"
sDestinationSheet = "TestSheet"
sSourceCell = "G10"
sDestinationCell = "G10"
vVal = "A10"
Col = 3
ThisWorkbook.Worksheets(sDestinationSheet).Range(sDestinationCell) = fGetValueTest(sFilePath, sFileName, sSourceSheet, sSourceCell, vVal, Col)
End Sub
I don't see any errors in how the VLOOKUP statement is constructed, does ExecuteExcel4Macro require a different type of statement or is there something else going on here?
Any help would be greatly appreciated, and if anyone happens to know if there is a manual for ExecuteExcel4Macro or any documentation of any real value that would also be helpful!
This is a possibility if it can be adopted:
Function:
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
Subroutine:
Sub TestThingSub()
Dim Varr As Variant
Varr = GetVlookup("\\store\GroupDrives\Pricing\_Deli_\Deli Fresh Shift\Margin Master\", "0306-0312 Margin Master2.xlsx", "Sheet2", "A1:B26", 2, "HORSE")
MsgBox Varr
End Sub

Get a value from a closed file

I was looking a post at this link: http://spreadsheetpage.com/index.php/site/tip/a_vba_function_to_get_a_value_from_a_closed_file/
The function is
Private 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
and to get a value,
Sub TestGetValue()
p = "c:\XLFiles\Budget"
f = "Budget.xls"
s = "Sheet1"
a = "A1"
MsgBox GetValue(p, f, s, a)
End Sub
and to loop
Sub TestGetValue2()
p = "c:\XLFiles\Budget"
f = "Budget.xls"
s = "Sheet1"
Application.ScreenUpdating = False
For r = 1 To 100
For c = 1 To 12
a = Cells(r, c).Address
Cells(r, c) = GetValue(p, f, s, a)
Next c
Next r
Application.ScreenUpdating = True
End Sub
I think it's very well written. However, I met two problems with it:
If the source cell in closed file is blank ("" in VBA), I would got 0 in getvalue.
I wonder how I can pass 0 to 0 and pass "" to ""?
Is there a bug for ExecuteExcel4Macro?
Suppose the source file has different extensions: xls, xlsx, xlsm, or xlsb,...
How can I get a dynamic path?
I tried to eliminate file extension in the path and use
arg = "'" & path & "[" & file & ".xl?]" & sheet & "'!" & _
Range(ref).Range("A1").Address(, , xlR1C1)
However, it didn't work in ExecuteExcel4Macro.
This is normal Excel behaviour. If you put a formula in a cell A1
=B1
then A1 will also show a 0
You can get a value with this code:
Public Function GetValue(sFileName As String, sSheetName As String, sAddress As String) As Variant
Dim oSheet As Worksheet
Application.ScreenUpdating = False
With Workbooks.Add(sFileName)
GetValue = .Sheets(sSheetName).Range(sAddress).Value
.Close
End With
Application.ScreenUpdating = True
End Function

ExecuteExcel4Macro to get value from closed workbook

I found this bit of code and thought it might be good to use if I just need to pull one value from a closed sheet.
strInfoCell = "'" & strPath & "[" & strFile & "]Sheet1'!R3C3"
myvalue = ExecuteExcel4Macro(strInfoCell)
When I run this code I get a value for strinfocell of
'C:\Users\my.name\Desktop[QOS DGL stuff.xlsx]Sheet1'!R3C3
But when I run the code a dialogue pops up, showing desktop files with "QOS DGL suff" showing.
What's causing this, why is it not just pulling back the data as expected?
I know the path and file name are right, because if I copy them from the debug output and paste them in to start>>run then the correct sheet opens.
I know that Sheet1 (named: ACL), does have a value in cells(3,3)
It depends on how you use it. The open file dialog box is being showed to you because the "strPath" doesn't have a "" in the end ;)
Try this code.
Option Explicit
Sub Sample()
Dim wbPath As String, wbName As String
Dim wsName As String, cellRef As String
Dim Ret As String
'wbPath = "C:\Documents and Settings\Siddharth Rout\Desktop\"
wbPath = "C:\Users\my.name\Desktop\"
wbName = "QOS DGL stuff.xls"
wsName = "ACL"
cellRef = "C3"
Ret = "'" & wbPath & "[" & wbName & "]" & _
wsName & "'!" & Range(cellRef).Address(True, True, -4150)
MsgBox ExecuteExcel4Macro(Ret)
End Sub
Similar application, but no hard coded paths as in the examples above. This function copies the value from another closed workbook, similar to the =INDIRECT() function, but not as sophisticated. This only returns the value...not a reference..so it cannot be used with further functions which require references (i.e.: VLOOKUP()). Paste this code into a new VBA module:
'Requires filename, sheetname as first argument and cell reference as second argument
'Usage: type in an excel cell -> =getvalue(A1,B1)
'Example of A1 -> C:\TEMP\[FILE1.XLS]SHEET1'
'Example of B1 -> B3
'This will fetch contents of cell (B3) located in (sheet1) of (c:\temp\file1.xls)
'Create a module and paste the code into the module (e.g. Module1, Module2)
Public xlapp As Object
Public Function getvalue(ByVal filename As String, ref As String) As Variant
' Retrieves a value from a closed workbook
Dim arg As String
Dim path As String
Dim file As String
filename = Trim(filename)
path = Mid(filename, 1, InStrRev(filename, "\"))
file = Mid(filename, InStr(1, filename, "[") + 1, InStr(1, filename, "]") - InStr(1, filename, "[") - 1)
If Dir(path & file) = "" Then
getvalue = "File Not Found"
Exit Function
End If
If xlapp Is Nothing Then
'Object must be created only once and not at each function call
Set xlapp = CreateObject("Excel.application")
End If
' Create the argument
arg = "'" & filename & "'!" & Range(ref).Range("A1").Address(, , xlR1C1)
'Execute an XLM macro
getvalue = xlapp.ExecuteExcel4Macro(arg)
End Function
Code above
strInfoCell = "'" & strPath & "[" & strFile & "]Sheet1'!R3C3"
myvalue = ExecuteExcel4Macro(strInfoCell)
Should read
strInfoCell = "'" & strPath & "[" & strFile & "]" & "Sheet1'!R3C3"
myvalue = ExecuteExcel4Macro(strInfoCell)
It is missing " & "
No need for a function
Cheers
Neil
Data = "'" & GetDirectory & "[" & GetFileName & "]" & Sheet & "'!" & Range(Address).Range("A1").Address(, , xlR1C1)
Address = "$C$3"
GetDirectory = "C:\Users\my.name\Desktop\"
GetFileName = "QOS DGL stuff.xlsx"
Sheet = "ACL"

Resources