I need to load information from another book into an empty book and link this information to another book using VLookup
I managed to pull the information out of the book, but now how can I link it to another book? I don't understand how to address it, just by opening it? And how best to organize the mapping using For... to ? The current code refers only to the first source workbook.
Sub Curse()
Dim sPath As String, sFile_1 As String, sFile1_2 As String, sheet As String, x As Integer
sSheet = "Sheet1"
sFile_1 = "Form.xlsx"
sFile1_2 = "Date1.xlsx"
sPath = InputBox("Enter the path where the files were saved")
If sPath Like "*\" Then
Else
sPath = sPath & "\"
End If
With Range("A2:B22")
.Formula = "='" & sPath & "[" & sFile_1 & "]" & sSheet & "'!" & "A2"
.Value = .Value
End With
For i = 2 To 22 Step 1
Cells(i, 3) = WorksheetFunction.VLookup(Cells(i, 1), Range("A1:C33"), 3)
Next
End Sub
Related
My first post so be kind! I'm trying to import multiple xml files using a schema but using a cell reference as part of the file name. The cell reference is a staff number so this is only to import xml files with that user's ID in the filename.
However, its only importing one file into my schema table instead multiples.
Sub ImportMyFiles()
Dim strFile As String, strPath As String, Num As Long, LR As Integer, UsrID As String
UsrID = Sheets("All_Fields").Range("A2")
strPath = "C:\QuAD_Output\"
strFile = Dir(strPath & UsrID & "*.xml")
Num = 0
While strFile <> ""
ActiveWorkbook.XmlMaps("QuAD_Schema_Map1").Import URL:= _
(strPath & strFile)
strFile = Dir
Num = Num + 1
LR = Cells(Rows.Count, "A").End(xlUp).Row
LR = LR + 1
Cells(LR, "A") = strFile
Wend
MsgBox "This code ran successfully for " & Num & " XML file(s)", vbInformation
End Sub`
See above, managed to resolve the issues with the table properties. Hope this helps someone else
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.
I have some vArrays which are not clearing out. The purspose of the macro is to work on a raw data tab which has 30+ tabs, each tab holding information for a specific office, 001-New York, etc. The macro is supposed to select x number of tabs (based on a reference file), copy them and save them into a new workbook. The problem is that instead of copying and saving from the raw data file it save the reference file instead. A For...Next loop is used to determine which tabs/offices to select & copy from the raw data file. The varrays are inside the loop and contain the names of the offices. When the code encounters the vArray the varray values are not clearing out when the loop circles back around.
Example:
'For 1' reference a cell with value of "8" so it populates 8 different vArray values (offices in this case). 'For 2' has a reference number of 5 and is supposed to populate 5 vArray values. It does this correctly as I can see the 5 new values in the locals window under vArray (1) thru vArray (5), however, vArray 6 thru 8 are showing values of the previous loop instead of 'Empty'. The vArray values are not clearing out when the macro loops.
sMasterListWBName is the reference file which tells the macro which tabs to copy from the raw data file and where to move the newly created workbook. The sub is also copying, saving, and distributing the reference file instead of the raw data file for some iterations of the loop (secondary issue--I will try to refrain from splitting the thread topic).
Thanks in advance to anyone who tries to answer this question.
Option Explicit
Dim iYear As Integer, iMonth As Integer, iVer As Integer, icount As Integer, iCount2 As Integer
Dim iLetter As String, iReport As String
Dim sMonth As String, sDate As String, sVer As String, sAnswer As String
Dim sFolderName As String, sManagerInitials As String
Dim iManagerNumber As Integer, iManagerStart As Integer, iTabNumber As Integer, iTabStart As Integer
Dim sMasterListWBName As String, sConsolidatedWBName As String, sExists As String
Dim oSheet As Object, oDistList As Object
Dim vArray(300) As Variant
Dim wbDistList As Workbook
Dim wsAgentListSheet As Worksheet, wsMain As Worksheet
Dim rCell As Range, rCell2 As Range, rCellTotal As Range
Public sFINorAgent As String
Sub Agent_Distribute()
On Error Resume Next
iYear = frm_fin_rep_main_distribute.txt_year
iMonth = frm_fin_rep_main_distribute.txt_month
iVer = frm_fin_rep_main_distribute.txt_version
sMonth = Right("0" & iMonth, 2)
sDate = iYear & "." & sMonth
sVer = "V" & iVer
sAnswer = MsgBox("Is the following information correct?" & vbNewLine & vbNewLine & _
"Report - " & frm_fin_rep_main.sLetter & vbNewLine & _
"Year - " & iYear & vbNewLine & _
"Month - " & sMonth & vbNewLine & _
"Name - " & frm_fin_rep_main.sReport & vbNewLine & _
"Version - " & sVer, vbYesNo + vbInformation, "Please verify...")
If sAnswer <> vbYes Then
Exit Sub
End If
Unload frm_fin_rep_main_distribute
frm_agent.Hide
Form_Progress
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
sConsolidatedWBName = ActiveWorkbook.Name
sMasterListWBName = "Dist Master List Final.xls"
If Not IsFileOpen(sMasterListWBName) Then
Workbooks.Open FileName:= _
"W:\Addins\01 GL - Distribution\" & sMasterListWBName, Password:="password"
Workbooks(sConsolidatedWBName).Activate
End If
Set oDistList = Workbooks(sMasterListWBName).Worksheets("Agent")
With oDistList
iManagerNumber = .Range("ManNumber2") 'range value = 66
For iManagerStart = 2 To iManagerNumber '2 to 66
If .Range("A" & iManagerStart) = "x" Then
iTabNumber = .Range("E" & iManagerStart) 'E2 to E66
sFolderName = .Range("F" & iManagerStart) 'F2 to F66
sManagerInitials = .Range("G" & iManagerStart) 'G2 to G66
For iTabStart = 1 To iTabNumber
vArray(iTabStart) = .Range("G" & iManagerStart).Offset(0, iTabStart)
Next iTabStart
If iTabNumber = 1 Then
Sheets(vArray(1)).Select
Else
Sheets(vArray(1)).Select
For iTabStart = 2 To iTabNumber
Sheets(vArray(iTabStart)).Select False
Next iTabStart
End If
ActiveWindow.SelectedSheets.Copy
' *** the following code is optional, remove preceding apostrophes from the following four lines to enable password protection ***
'For Each oSheet In ActiveWorkbook.Sheets
'oSheet.Protect "password"
'oSheet.EnableSelection = xlNoSelection
'Next
ActiveWorkbook.SaveAs FileName:= _
"W:\Financials\" & iYear & "\" & sDate & "\Report to Distribute Electronically\Department Reports\" _
& sFolderName & "\Current Year Financials" & "\" & "Y" & ") " & iYear & "-" & sMonth & " Agent Report Card " & sVer & " - " & sManagerInitials & ".xls"
ActiveWorkbook.Close
End If
iPercent = iManagerStart / iManagerNumber * 95
Task_Progress (iPercent)
Next iManagerStart
End With
Workbooks(sMasterListWBName).Close False
Task_Progress (100)
Unload frm_progress
Set oDistList = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Message_Done
frm_agent.Show (vbModeless)
End Sub
I fixed it. I just added "Workbooks(sWbName).activate" at the end of the loop to make sure the focus is back on the raw data file. Now all files are saving in the correct format and location. Case closed unless someone has anything else to add. Maybe someone knows the reason the macro was losing sight of its active sheet (saving reference file instead of raw data file). Thank you.
I have 2 spreadsheets, EG. test1.xlxs and test2.xlsm
test1 has the following data on sheet 1 cell B6: testdata
test2 has some vba code I want to disable if test1 is not present or has the wrong information in it, as such, I need to use an environmental variable in the VBA IF statement that that I don't have to edit the code or re link the sheets every time I move them to a new pc
The problem I have is, when I use the environmental variable The If statement tests against the string and not the cell value EG "=C:\users\username\documents[test.xlxs]Sheet1'!$B$6" instead of testdata
This is the code I currently have in test2:
Sub Check_Key()
Dim Key As String
Key = "='" & Environ("USERPROFILE") & "\Documents\[test.xlxs]Sheet1'!$B$6"
If Key = Sheet1.Range("D8") = True Then
Sheet1.Range("D9") = "Valid"
Else
Sheet1.Range("D9") = "Invalid"
End If
End Sub
is there any way to make it work?
I would prefer to have the VBA script do the verification rather than an if statement in a cell on the workbook
Requirements:
User should not be able to see data in test1 (spreadsheet should stay closed)
Data from test1 needs to be verified via VBA IF statement
test2 should be able to be anywhere on pc while test1 should be in my documents
Here is a link to the Spreadsheets, it includes the Licence file the test sheet and a key generator
Documents
The following code copies the value in cell B6 from the closed workbook.
Sub test()
'variables
Dim key As Variant, FolderName As String, wbName As String
FolderName = Environ("USERPROFILE") & "\Documents"
wbName = Dir(FolderName & "\" & "test.xlsx") 'Workbook name
key = GetInfoFromClosedFile(FolderName, wbName, "Sheet1", "B6")
End Sub
'Returns value in cell CREDIT: http://erlandsendata.no/?p=2106
Private Function GetInfoFromClosedFile(ByVal wbPath As String, wbName As String, wsName As String, cellRef As String) As Variant
Dim arg As String
GetInfoFromClosedFile = vbNullString
If Right(wbPath, 1) <> "\" Then wbPath = wbPath & "\"
If Dir(wbPath & wbName) = vbNullString Then Exit Function
arg = "'" & wbPath & "[" & wbName & "]" & wsName & "'!" & Range(cellRef).Address(True, True, xlR1C1)
'On Error Resume Next
GetInfoFromClosedFile = ExecuteExcel4Macro(arg)
End Function
If the test1 is already open in the same excel instance :
key = workbooks("test1.xlsm").worksheets("sheet1").range("B6")
If he is not
set wbk = Workbooks.open (Environ("USERPROFILE") & "\Documents\test.xlsx")
key = wbk.worksheets("sheet1").range("B6")
' other code
wbk.close false
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"