VBA - Subscript out of Range when Workbooks().Close - vba

I would like to loop through all excel workbooks in a folder and write the string "Test" in Cell A1 of every sheet of every workbook.
The following code results in 'Subscript out of Range(Error 9)'.
When I ran the code line by line it turned out the Error is caused by the
line:
Workbooks(FName).Close Savechanges:=True Dir("C\...") stored in FName returns just the file name so the error can't be because of giving the full path name to Workboooks(...).Close which seems often to be the reason for the error.On top of that this code really opens the workbook instead of just writing into it. I don't want it
to open visually.
Sub multWB()
Dim FName As String
Dim wb As Workbook
Dim sht As Worksheet
Dim directory As String
directory = "C:\Users\...\Desktop\multipleWorkbooks\"
FName = Dir("C:\Users\...\Desktop\multipleWorkbooks\*.xls*")
Do While FName <> ""
Set wb = Workbooks.Open(directory & FName)
For Each sht In wb.Worksheets
sht.Cells(1, 1) = "Test"
Next
FName = Dir
Workbooks(FName).Close Savechanges:=True 'causes error
Loop
Set wb = Nothing
End Sub

You already have a reference to the workbook with wb. Just use that reference!
wb.Close SaveChanges:=True
Anything else is dereferencing objects for no reason.

You are retrieving the name of the next workbook before closing the current open one. Switch the order those two lines of code:
Workbooks(FName).Close Savechanges:=True
FName = Dir()

This: FName = Dir is missing the folder name. Change it to this:
FName = directory & Dir()

Related

Run VBA macro in another workbook while using main workbook [duplicate]

I have a workbook which opens up another workbook (filename is based on a cell value) and then runs a macro called Single_sector within that file.
It opens the file perfectly fine but doesn't run the macro. Any ideas?
Sub run_all()
Dim Location
On Error Resume Next
'Location of file to open
Location = Worksheets("Main").Range("folder_location").Value
'Open F&V File
Application.Workbooks.Open Location & Range("fv_file").Value
'Run Macro
Run ("Single_sector")
End Sub
Place the following code in the macro calling the other workbook:
Location = Worksheets("Main").Range("folder_location").Value
Set wb = Workbooks.Open(Location & Range("fv_file").Value)
Application.Run "'" & wb.Name & "'!" & strSubToRun, Parameters
Set wb = Nothing
Parameters is an array of arguments that you want to pass, so the sub in the other workbook should look something like
Public Sub TheSub(ParamArray X())
Dim i As Long
Sheet1.Cells(1, 1).Value = "Parameters passed:"
For i = 0 To UBound(X(0))
Sheet1.Cells(i + 2, 1).Value = CStr(X(i))
Next
End Sub
Probably not very elegant but:
Dim Location As String
Location = "\\location\to\file.xlsm"
Workbooks.Open(Location).RunAutoMacros (xlAutoOpen)
Where you have an Auto_Open Sub in your other excel file to handle the macros to run on your other spreadsheet
Please make sure your code in another workbook is at Workbook_open event so you dont need to use Run ("Single_sector"). The procedure single_selector would trigger as soon as another workbook is open.
Updated answer
Sub run_all()
Dim Location
On Error Resume Next
Dim wkb As Workbook
'Location of file to open
Location = Worksheets("Main").Range("folder_location").Value
'Open F&V File
Set wkb = Workbooks.Open(Location & Range("fv_file").Value)
wkb.Sheets(1).Single_sector ' kindly put this proc in another workbook sheet1
End Sub

Sheet To Workbook using VBA

I have found the below code to save sheet as new workbook but what I wanted to know if it is possible to change the save name
each time the macro is run to the value on sheet 1 in cells B2 and to a specific file location.
I have tried the way below and it just simply saves the file with the name of the file location instead of saving it in the file location specified.
Sub sb_Copy_Save_Worksheet_As_Workbook()
Dim wb As Workbook
Set wb = Workbooks.Add
ThisWorkbook.Sheets("Sheet2").Copy Before:=wb.Sheets(1)
wb.SaveAs "C:\temp\test1.xlsx"
End Sub
Any help would be greatly appreciated
many thanks
Jamie
Let's say "Sheet1" has in cell B2 the value "test1" (the filename), then you can use the following:
Sub sb_Copy_Save_Worksheet_As_Workbook()
Dim wb As Workbook
Dim myPath As String
Dim myFilename As String
Dim myFileExtension As String
myPath = "C:\temp\" 'you can change this
myFileExtension = ".xlsx"
myFilename = ThisWorkbook.Sheets("Sheet1").Range("B2").Value
Set wb = Workbooks.Add
ThisWorkbook.Sheets("Sheet2").Copy Before:=wb.Sheets(1)
wb.SaveAs myPath & myFilename & myFileExtension
wb.Close False
End Sub
If your cell B2 already includes the file extension (so it is "test1.xlsx" in B2), just remove the myFileExtension parts from the code.
The folder, where you want to save your file has to exist. If you need help checking this or creating the folder in your macro, please leave a comment.
Try adding on the cell value to the path string like this:
Sub sb_Copy_Save_Worksheet_As_Workbook()
Dim wb As Workbook
Set wb = Workbooks.Add
ThisWorkbook.Sheets("Sheet2").Copy Before:=wb.Sheets(1)
wb.SaveAs "C:\temp\" & ThisWorkbook.Sheets("Sheet2").Range("B2").Value
End Sub
File extension will default to .xlsx even if the original file is .xlsm so you don't need to add this to the path string.

VBA refine code .PrintOut to define pdf Filename and current location

I have a macro that selects worksheets to be printed from worksheets that carry a value in cell A1.
I am trying to adjust the code so that it will print the pdf file with a predetermined name, eg "Output.pdf" and into the folder that the excel file is currently saved
I do not have the VBA skills to do it - I have been trying to find code in various forums, without luck.
My code currently is:
Sub Print_All_Worksheets_With_Value_In_A1()
Dim Sh As Worksheet
Dim Arr() As String
Dim N As Integer
N = 0
Application.ActivePrinter = "Adobe PDF on Ne07:"
For Each Sh In ActiveWorkbook.Worksheets
If Sh.Visible = xlSheetVisible And Sh.Range("A1").Value <> "" Then
N = N + 1
ReDim Preserve Arr(1 To N)
Arr(N) = Sh.Name
End If
Next
With ActiveWorkbook
.Worksheets(Arr).PrintOut
End With
End Sub
Any help with refining this area i n particular will be greatly appreciated
With ActiveWorkbook
.Worksheets(Arr).PrintOut
I have a slightly different idea for how to do this.
You have created an array of worksheets with Arr variable. I think instead of this:
With ActiveWorkbook
.Worksheets(Arr).PrintOut ...
End With
Do this:
Dim path as String
'Capture the path of the current workbook
path = ActiveWorkbook.Path & "\"
'The copy method will create a NEW workbook with these sheets
ActiveWorkbook.Worksheets(arr).Copy
'The NEW workbook is now "Active", so use ActiveWorkbook and exportAsFixedFormat
ActiveWorkbook.ExportAsFixedFormat xlTypePDF, path & "output.pdf"
'Closes the temporary workbook without warning
Application.DisplayAlerts = False
ActiveWorkbook.Close
Application.DisplayAlerts = True

Trying to open a Workbook and a run a macro in that file

I have a workbook which opens up another workbook (filename is based on a cell value) and then runs a macro called Single_sector within that file.
It opens the file perfectly fine but doesn't run the macro. Any ideas?
Sub run_all()
Dim Location
On Error Resume Next
'Location of file to open
Location = Worksheets("Main").Range("folder_location").Value
'Open F&V File
Application.Workbooks.Open Location & Range("fv_file").Value
'Run Macro
Run ("Single_sector")
End Sub
Place the following code in the macro calling the other workbook:
Location = Worksheets("Main").Range("folder_location").Value
Set wb = Workbooks.Open(Location & Range("fv_file").Value)
Application.Run "'" & wb.Name & "'!" & strSubToRun, Parameters
Set wb = Nothing
Parameters is an array of arguments that you want to pass, so the sub in the other workbook should look something like
Public Sub TheSub(ParamArray X())
Dim i As Long
Sheet1.Cells(1, 1).Value = "Parameters passed:"
For i = 0 To UBound(X(0))
Sheet1.Cells(i + 2, 1).Value = CStr(X(i))
Next
End Sub
Probably not very elegant but:
Dim Location As String
Location = "\\location\to\file.xlsm"
Workbooks.Open(Location).RunAutoMacros (xlAutoOpen)
Where you have an Auto_Open Sub in your other excel file to handle the macros to run on your other spreadsheet
Please make sure your code in another workbook is at Workbook_open event so you dont need to use Run ("Single_sector"). The procedure single_selector would trigger as soon as another workbook is open.
Updated answer
Sub run_all()
Dim Location
On Error Resume Next
Dim wkb As Workbook
'Location of file to open
Location = Worksheets("Main").Range("folder_location").Value
'Open F&V File
Set wkb = Workbooks.Open(Location & Range("fv_file").Value)
wkb.Sheets(1).Single_sector ' kindly put this proc in another workbook sheet1
End Sub

Copy data from another Workbook through VBA

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.