I have two sheets, where I need to refresh values (function VLOOKUP) from source.xlsm to update.xlsm ON BACKGROUND by VBA (only manual refresh by button with assigned macro - I do not want to use update button in Excel options).
I have found two codes, which complete this task, however, the source.xlsm always pops up for a second while the task is made. I would like to have the task completed without the source file being visible on the screen.
Any ideas?
Sub Read_External_Sheet()
'''''Define Object for Target Workbook
Dim Target_Workbook As Workbook
Dim Source_Workbook As Workbook
Dim Target_Path As String
'''''Assign the Workbook File Name along with its Path
'''''Change path of the Target File name
Target_Path = "D:\Source.xlsm"
Set Target_Workbook = Workbooks.Open(Target_Path)
Set Source_Workbook = ThisWorkbook
'''''With Target_Workbook object now, it is possible to pull any data from it
'''''Read Data from Target File
Target_Data = Target_Workbook.Sheets(1).Cells(1, 1)
DoEvents
Source_Workbook.Sheets(1).Cells(1, 1) = Target_Data
DoEvents
'''''Update Target File
Source_data = Source_Workbook.Sheets(1).Cells(3, 1)
DoEvents
Target_Workbook.Sheets(1).Cells(2, 1) = Source_data
DoEvents
'''''Close Target Workbook
Target_Workbook.Close False
'''''Process Completed
MsgBox "SHEET UPDATED"
End Sub
Sub Read_External_Sheet_2()
Dim FName As Workbook
With Application
.EnableEvents = False
Set FName = .Workbooks.Open("D:\Source.xlsm", False)
mybook = FName.Name
With FName
.RefreshAll
.Close True 'save file
End With
.EnableEvents = True
End With
msg = MsgBox(mybook & " Refreshed")
End Sub
Related
This question already has answers here:
Run Excel Macro from Outside Excel Using VBScript From Command Line
(8 answers)
Closed 3 months ago.
This post was edited and submitted for review 3 months ago and failed to reopen the post:
Original close reason(s) were not resolved
I am trying to call a VBA function from VBS script:
VBA
Function f_split_master_file(output_folder_path As String, master_excel_file_path As String) As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error GoTo ErrorHandler
Dim wb As Workbook
Dim output As String
' Variables related with the master excel file
Dim wb_master As Workbook
Dim ws_master As Worksheet
Dim master_range As Range
Dim responsible_names_range As Range
Dim responsible_name As Range
Dim last_row_master As Integer
' Variables related with the responsible name excel
Dim savepath As String
Dim wb_name As Workbook
Dim ws_name As Worksheet
Dim name As Variant
' Check whether master file exists
If Len(Dir(master_excel_file_path)) = 0 Then ' Master file does not exist
Err.Raise vbObjectError + 513, "Sheet1::f_split_master_file()", "Incorrect Master file path, file does not exist!"
End If
' Check whether output folder exists
If Dir(output_folder_path, vbDirectory) = "" Then ' Output folder path does not exist
Err.Raise vbObjectError + 513, "Sheet1::f_split_master_file()", "Incorrect output folder path, directory does not exist!"
End If
Set wb_master = Workbooks.Open(master_excel_file_path)
Set ws_master = wb_master.Sheets(1)
last_row_master = ws_master.Cells(Rows.Count, "AC").End(xlUp).row
Set master_range = ws_master.Range("A1:AD" & last_row_master)
Set responsible_names_range = ws_master.Range("AC2:AC" & last_row_master) ' Get all names
data = get_unique_responsibles(responsible_names_range) 'Call function to get an array containing distict names (column AC)
For Each name In data
'Create wb with name
savepath = output_folder_path & "\" & name & ".xlsx"
Workbooks.Add
ActiveWorkbook.SaveAs savepath
Set wb_name = ActiveWorkbook
Set ws_name = wb_name.Sheets(1)
master_range.AutoFilter 29, Criteria1:=name, Operator:=xlFilterValues
master_range.SpecialCells(xlCellTypeVisible).Copy
ws_name.Range("A1").PasteSpecial Paste:=xlPasteAll
wb_name.Close SaveChanges:=True
' Remove filters and save workbook
Application.CutCopyMode = False
ws_master.AutoFilterMode = False
Next name
CleanUp:
' Close all wb and enable screen updates and alerts
For Each wb In Workbooks
If wb.name <> ThisWorkbook.name Then
wb.Close
End If
Next wb
Application.ScreenUpdating = True
Application.DisplayAlerts = True
f_split_master_file = output ' empty string if successful execution
Exit Function
ErrorHandler:
' TODO: Log to file
' Err object is reset when it exits from here IMPORTANT!
output = Err.Description
Resume CleanUp
End Function
VBS
Set excelOBJ = CreateObject("Excel.Application")
Set workbookOBJ = excelOBJ.Workbooks.Open("C:\Users\aagir\Desktop\BUDGET_AND_FORECAST\Macro_DoNotDeleteMe_ANDONI.xlsm")
returnValue = excelOBJ.Run("sheet1.f_split_master_file","C:\Users\aagir\Desktop\NON-EXISTENT-DIRECTORY","C:\Users\aagir\Desktop\MasterReport_29092022.xlsx")
workbookOBJ.Close
excelOBJ.Quit
msgbox returnValue
The macro (VBA function) works fine. The only thing that I am missing is within the VBS script. When I call the vba function from vbs script it runs fine but I cannot get the return value in the "returnValue" variable defined in VBS (it does not show anything). Can anyone tell what I am doing wrong? Thanks!
Based on the name sheet1 (in your VBS script), I'm assuming the f_split_master_file Function is in a Worksheet module. Move it to a standard Module and change sheet1 to (eg) Module1 and then try again.
The below code first checks if the required file is open, if it is open then use that file; if not, then open file from the path provided in the cell and read/write with that file. After completing the task, It further checks if the file path & name provided in the below cell is same or not, if same, then do nothing; if not, close the opened file without saving.
It works fine until the file path and name are same in the below cell. Throws an error when the file path and name is different in the below cell. It does not opens the file.
Not sure where am I going wrong. Can someone please help?
Asked Here - https://www.mrexcel.com/board/threads/open-file-if-not-already-open.1199858/
Asked here - https://chandoo.org/forum/threads/open-file-if-not-already-open.47763/
Sub RunQuery1()
Dim Lastrow As Long
Dim OpenBook_path, Available_File As String
Dim FileToOpen As Workbook
Dim wb As Workbook
Application.ScreenUpdating = False
Lastrow = ThisWorkbook.Sheets("Dashboard").Range("F" & Rows.Count).End(xlUp).Row
For i = 9 To Lastrow
OpenBook_path = ThisWorkbook.Sheets("Dashboard").Cells(i, 6) 'Path includes file name with extension
OpenBook_Sheet = ThisWorkbook.Sheets("Dashboard").Cells(i, 7)
OpenBook_Range = ThisWorkbook.Sheets("Dashboard").Cells(i, 8)
'Check if file is open,if open, then use open file; if not, open file from the path in the cell
Available_File = Dir(OpenBook_path) 'extracts the file name from the path
If Not wbOpen(Available_File, wb) Then Set FileToOpen = Workbooks.Open(OpenBook_path)
'open workbook from the path in the cell
With FileToOpen
'Copy range from the sheet
With Sheets(OpenBook_Sheet)
.Range(OpenBook_Range).Select 'Do something
End With
End With
'Check if Below File Path & Name are same
If ThisWorkbook.Sheets("Dashboard").Cells(i, 6) = ThisWorkbook.Sheets("Dashboard").Cells(i + 1, 6) Then
Else
FileToOpen.Close False
End If
Next i
Application.ScreenUpdating = True
End Sub
Function wbOpen(wbName As String, wbO As Workbook) As Boolean
On Error Resume Next
Set wbO = Workbooks(wbName)
wbOpen = Not wbO Is Nothing
End Function
struggling to copy a worksheet from source book to destination book.
I've tried 4 different codes found on SO, but running into different errors all the time.
Either: "Copy method failed", "No such interface found", "Exception"- at the copy function.
I know that there are a lot of links and websites referring to the copy method, but i've tried them all and still no luck.
Option Strict = Off
Option Explicit = On
Excel 2016
VS 2019
Sourceworkbook has formatting in and merged cells. Needing the formatting included in the copy method, because I'll be using the new workbooks as back-ups or copies for printing. The sourceworkbook has a template on one of the sheets named "TempPage".
Code:
xlApp1 = New Excel.Application
xlWorkBook1 = xlApp1.Workbooks.Add
'xlWorkSheet1 = CType(xlWorkBook1.Sheets.Add(), Excel.Worksheet)
xlWorkSheet = CType(xlWorkBook.Sheets("TempPage"), Excel.Worksheet) 'Source
xlWorkSheet1 = CType(xlWorkBook1.Sheets("Sheet1"), Excel.Worksheet) 'Destination
'Tried this code
'Dim rngSource As Excel.Range, rngTarget As Excel.Range, targetRow As Long
'rngSource = xlWorkBook.Sheets("TempPage").UsedRange
'With xlWorkBook.Sheets("TempPage")
'targetRow = .UsedRange.SpecialCells(XlCellType.xlCellTypeLastCell).Row + 1
'rngTarget = .cells(targetRow, rngSource.Column)
'End With
'rngSource.Copy(rngTarget)
'Tried this code
'Dim sourceWorkSheet As Excel.Worksheet
'sourceWorkSheet = xlWorkBook.Sheets("TempPage")
'//Copies the source worksheet to the destination workbook, places it after the last
'//sheet in the destination workbook.
'sourceWorkSheet.Copy(, xlWorkBook1.Sheets(xlWorkBook1.Sheets.Count))
'Tried this
'xlWorkSheet.Copy(, xlWorkBook1.Sheets(xlWorkBook1.Sheets.Count))
'tried this
'xlWorkSheet1.Range("A1:I46").Value = xlWorkSheet.Range("A1:I46").Value
'xlWorkSheet.Application.Goto(xlWorkSheet.Range("A1:I46"), True)
'xlWorkSheet.Range("A1:I46").Select()
'xlWorkSheet.Range("A1:I46").Copy()
'xlWorkSheet1.PasteSpecial(Excel.XlPasteType.xlPasteAll,
'Excel.XlPasteSpecialOperation.xlPasteSpecialOperationNone, False, False)
'Tried this
'xlWorkSheet.Range("A1:I46").Copy(xlWorkSheet1.Range("A1:I46"))
'xlWorkSheet1.PasteSpecial(Excel.XlPasteType.xlPasteFormats)
xlWorkBook1.SaveAs(BTPath & "\" & xlWorkSheet.Range("B3").Value & ".xls", Excel.XlFileFormat.xlExcel5) 'save the receipt as the ticket number
If RadioButton3.Checked = True Then
'unpaid - send copy to unpaid folder
xlWorkBook1.SaveAs(UnpaidPath & "\" & xlWorkSheet.Range("B3").Value & ".xls", Excel.XlFileFormat.xlExcel5)
ElseIf RadioButton4.Checked = True Then
End If
I need help with the copying method please.
After a bit more research, found a way to save the worksheet from the source book. Closing the book and reopening the source book for continued usage. Only problem i'm now running into, is that the formulas are still being copied as well and some cells aren't in the same format(bold, merged, size) but found a link on SO - Save values (not formulae) from a sheet to a new workbook?
New code:
'save first
xlWorkBook.Save() 'Save the workbook
Dim newpath As String = BTPath & "\" & xlWorkSheet.Range("B3").Value & ".xls"
xlWorkSheet = CType(xlWorkBook.Sheets("TempPage"), Excel.Worksheet)
xlWorkSheet.Copy()
xlWorkSheet.SaveAs(newpath, Excel.XlFileFormat.xlExcel5)
If RadioButton3.Checked = True Then
'unpaid - send copy to unpaid folder
xlWorkBook.SaveAs(BTPath & "\" & xlWorkSheet.Range("B3").Value & ".xls")
End If
'Close the file and reopen the database file
xlWorkBook.Save() 'Save the workbook
xlWorkBook.Close() 'Close workbook
If xlApp Is Nothing Then
'do nothing
Else
xlApp.Quit() 'Quit the application
End If
GC.Collect()
GC.WaitForPendingFinalizers()
System.Threading.Thread.Sleep(500)
GC.Collect()
GC.WaitForPendingFinalizers()
System.Threading.Thread.Sleep(500)
'reopen
xlApp = New Excel.Application
xlWorkBook = xlApp.Workbooks.Open(filepath)
'clear the sheet
xlWorkSheet = CType(xlWorkBook.Sheets("TempPage"), Excel.Worksheet)
xlWorkSheet.Range("D45").Value = ""
xlWorkSheet.Range("B3").Value = ""
xlWorkSheet.Range("B10").Value = ""
xlWorkSheet.Range("F10").Value = ""
xlWorkSheet.Range("F12").Value = ""
xlWorkSheet.Range("B11").Value = ""
xlWorkSheet.Range("F11").Value = ""
xlWorkSheet.Range("I10").Value = ""
xlWorkSheet.Range("A14:H10").Value = ""
'save but don't close
xlWorkBook.Save() 'Save the workbook
Source column contains a string in each cell. There are 4000+ cells. These need to be copied and pasted into a worksheet of the active (one that invoked the macro) workbook. Source workbook should be selected by the user using a search/browse pop-up box.
The below code does something close to my intended goal, but the directory as you see is static which is unacceptable. Maximum flexibility should be had with user choosing the source file manually. Furthermore I want to prevent the file path from becoming obsolete every time folders/files get renamed/shifted. Something tell me Application.GetOpenFilename() should be used, but how to correctly implement it?
Having little experience with the VBA, my attempts to mod this macro failed, so I'm asking for your advice on this matter. Again, the below code works well, but it's not flexible enough to be practical.
Edit: the problem is solved. See the final working code.
'MACRO TO READ-IN EXTERNAL EXCEL FILE FROM WHICH JOB NO.'S ARE EXTRACTED INTO USERFORM
Sub ReadDataFromCloseFile()
'IN CASE OF ERROR SEND TO ERROR FUNCTION
On Error GoTo ErrHandler
'PREVENT OPENED EXCEL SOURCE FILE FROM SHOWING TO USER
Application.ScreenUpdating = False
'OPEN SOURCE EXCEL WORKBOOK IN "READ ONLY MODE"
Dim SrcName As String
Dim src As Workbook
SrcName = Application.GetOpenFilename()
Set src = Workbooks.Open(SrcName, True, True)
'GET THE TOTAL ROWS FROM THE SOURCE WORKBOOK
Dim iTotalRows As Integer
iTotalRows = src.Worksheets("PROJECT LIST").Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).Rows.Count
'COPY DATA FROM SOURCE WORKBOOK -> DESTINATION WORKBOOK
Dim iCnt As Integer '(COUNTER)
For iCnt = 1 To iTotalRows
Worksheets("Test_File_8").Range("B" & (iCnt + 1)).Formula = src.Worksheets("PROJECT LIST").Range("A" & (iCnt + 1)).Formula
Next iCnt
'CLOSE THE SOURCE WORKBOOK FILE
src.Close False 'FALSE = DONT SAVE THE SOURCE FILE
Set src = Nothing 'FLUSH DATA
'ERROR FUNCTION
ErrHandler:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
See my changes below. I added two variables X and strSrc. X is a variant that is used to loop through .SelectedItems and strSrc is that string that ultimately holds the path.
Sub ReadDataFromCloseFile()
'Set variable to hold workbook path and workbook path string
Dim X as Variant
Dim strSrc as String
With Application.FileDialog(msoFileDialogFilePicker)
.InitialFileName = "" ' You can provide a base path here
.Title = "Select file."
.AllowMultiSelect = False
If .Show = -1 Then
For Each X In .SelectedItems
strSrc = X
Exit For
Next X
End If
End With
'IN CASE OF ERROR SEND TO ERROR FUNCTION
'On Error GoTo ErrHandler
'PREVENT OPENED EXCEL SOURCE FILE FROM SHOWING TO USER
Application.ScreenUpdating = False
'OPEN SOURCE EXCEL WORKBOOK IN "READ ONLY MODE"
Dim src As Workbook
Set src = Workbooks.Open(strSrc, True, True)
'GET THE TOTAL ROWS FROM THE SOURCE WORKBOOK
Dim iTotalRows As Integer
iTotalRows = src.Worksheets("PROJECT LIST").Range("A1:A" & src.Worksheets("PROJECT LIST").Cells(Rows.Count, "A").End(xlUp).Row).Rows.Count
'COPY DATA FROM SOURCE WORKBOOK -> DESTINATION WORKBOOK
Dim iCnt As Integer '(COUNTER)
For iCnt = 1 To iTotalRows
src.Worksheets("Test_File_8").Range("B" & (iCnt + 1)).Formula = src.Worksheets("PROJECT LIST").Range("A" & (iCnt + 1)).Formula
Next iCnt
'CLOSE THE SOURCE WORKBOOK FILE
src.Close False 'FALSE = DONT SAVE THE SOURCE FILE
Set src = Nothing 'FLUSH DATA
'ERROR FUNCTION
ErrHandler: Application.EnableEvents = True Application.ScreenUpdating = True End Sub
'MACRO TO READ-IN EXTERNAL EXCEL FILE FROM WHICH JOB NO.'S ARE EXTRACTED INTO USERFORM
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.