Stay in the active workbook after opening other workbooks - vba

I am trying to open two other Excel workbooks to take data to do my calculation through the macro. I have a working code to open those files.
Dim wbCount As Integer
Application.ScreenUpdating = False
For wbCount = 1 To 2
Workbooks.Open Filename:=ThisWorkbook.Path & "\Installation Sheet " & wbCount & ".xlsm", UpdateLinks:=False
Next wbCount
ThisWorkbook.Activate
Application.ScreenUpdating = True
The other files are named "Installation Sheet 1" and "Installation Sheet 2". After this code runs, I end up with "Installation Sheet 1" displaying instead of my active workbook.

Put your ActiveWorkbook into a variable at the appropriate place and then use that to move back. ThisWorkbook is the one with code in. So be sure if you mean ActiveWorkbook or ThisWorkbook, or if ThisWorkbook is the ActiveWorkbook at the time. In that case, you can simply Set wb = ThisWorkbook
Dim wb As Workbook
Set wb = ActiveWorkbook
'Set wb = ThisWorkbook '<== If you want the workbook containing the code
'Other code
wb.Activate

You have to put your workbooks references into variables and then using these variables you have two options: close newly opened workbook, so only original stays opened or use Activate method to bring the original workbook to front.
Sample code:
Sub OpeningWb()
Dim wb As Workbook, currentWb As Workbook
Set currentWb = ThisWorkbook
Set wb = Workbooks.Open("your path here")
' if you want to close opened workbook
'wb.Close
' if you want to bring to front original workbook
currentWb.Activate
End Sub
Alternatively, you can do the following:
Dim wbToDisplay As Workbook
Set wbToDisdplay = Workbooks("workbook name here")
wbToDisplay.Activate

The above solutions didn't work for me, because activate method is fired before second workbook is displayed, so I get active this second workbook always. My workaround is wait a couple of seconds before calling Activate method:
Dim t: t = Timer
While Timer < t + 2 'wait for 2 seconds
DoEvents
Wend
ThisWorkbook.Activate

Related

Vba Excel error using SaveAs with password

I wrote a simply code to save every Excel Worksheet as a new file (.xlsx) protected with password:
For i = 1 To 7
ThisWorkbook.Sheets(i).Copy
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & i & ".xlsx", FileFormat:=51, Password:="XXX"
ActiveWorkbook.Close False
Next i
It works but the error is that the created files seem to have a sort of autorun (they auto-open if you simply click on the icons) and then the Excel popup about password shows "copy of && is protected" in adding to "&& is protected" and ask for the password twice.
Any ideas?
Thanks
A general peace of advice, do not use ThisWorkbook, ActiveWorkbook, Active Worksheet etc. if not 100% neccessary. It more often than not causes problems. Second thing, sometimes a few more lines of code are better than less, because of debugability.
The most important points of code below: Your workbook of source is defined as wbSource and you initialize a variable wbTarget. For each worksheet in the workbook you create a new workbook by Set wbTarget = Workbooks.Add copy the sheet mySheet the iterator to it, set the password and save it. This can be done in one row, but again this is very clear and debugable.
Sub test()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim wbSource As Workbook, wbTarget As Workbook
Dim wsToCopy As Worksheet
Set wbSource = ThisWorkbook
For Each mySheet In wbSource.Sheets
Set wbTarget = Workbooks.Add
mySheet.Copy Before:=wbTarget.Sheets(1)
wbTarget.Password = "XXX"
wbTarget.Close True, mySheet.Name
Next mySheet
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

VBA - Cut & Paste cells between workbooks

Dim wbTarget As Workbook
Dim wbSource As Workbook
Set wbTarget = ThisWorkbook
Set wbSource = Workbooks.Open("C:\Users\alibe\Desktop\PoS\Alain.xlsx")
wbSource.Worksheets("Spain").Range("plage_sp").Copy
wbSource.Activate
Set wbTarget = ThisWorkbook
wbTarget.Worksheets("Feui1").Range("A1").PasteSpecial xlPasteAll
wbTarget.Save
wbTarget.Close
Hi everybody,
I am trying to cut and paste cells between two different workbooks. But I got failure 9 or 438 in my Paste line. May somebody give a help please.
There's a couple things we want change.
First, it's good practice to get into the habit of having excel check whether your file location exists or not. You might think you have it put in correctly, but it's always best to make sure excel feels the same way. (This also makes your code more flexible for later use.)
When opening workbooks and closing them, there's no reason to bog your system down trying to open new windows quickly. Since we don't need to see what it's doing, just that it's done it, we can turn ScreenUpdating and DisplayAlerts to false until the end of our code.
You should check the spelling on your worksheet "Feui1", that it's not actually "Feuil".
For the application of defining different ranges by workbook, we need to use .Sheets() object instead of .Worksheets()
Also, it's not common to see that you have this code in the same file that you're closing, when you're opening another file. At the end of this routine, ThisWorkbook is going to close, and wbSource will be left open. Is this intentional? Just something I thought I'd point out.
Sub CopyPasta()
Dim wbTarget As Workbook: Set wbTarget = ThisWorkbook
Dim wbSource As Workbook, sourceFile As String
sourceFile = "C:\Users\alibe\Desktop\PoS\Alain.xlsx"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
If Dir(sourceFile) = "" Then 'Checks that file location exists
MsgBox "File not found.", vbCritical, "Bad File Address"
Exit Sub
End If
Set wbSource = Workbooks.Open(sourceFile)
wbSource.Sheets("Spain").Range("plage_sp").Copy
wbTarget.Sheets("Feuil").Range("A1").PasteSpecial xlPasteAll 'Spelling on 'Feuil'
Application.ScreenUpdating = True
Application.DisplayAlerts = True
wbTarget.Save
wbTarget.Close 'You want to close the workbook that this code is in?
End Sub
Few changes
Dim wbTarget As Workbook
Dim wbSource As Workbook
Set wbTarget = ThisWorkbook
Set wbSource = Workbooks.Open("C:\Users\alibe\Desktop\PoS\Alain.xlsx")
wbSource.Sheets("Spain").Range("plage_sp").Copy
wbTarget.Sheets("Feui1").Range("A1").PasteSpecial Paste:=xlPasteAll
wbTarget.Save
wbTarget.Close

VBA Error 'Subscript out of Range'

I am trying to create a copy of a large macro enabled (xlsm) file in xlsx format.
Sub Button1_Click()
Dim wb As Workbook
Set wb = Workbooks.Open("C:\original.xlsm")
Dim mySheetList() As String
ReDim mySheetList(0 To (ThisWorkbook.Sheets.Count) - 1)
Dim a As Integer
a = 0
For Each ws In ActiveWorkbook.Worksheets
mySheetList(a) = ws.Name
a = a + 1
Next ws
'actually save
Worksheets(mySheetList).Copy
ActiveWorkbook.SaveAs Filename:="ORIGINAL_COPY.xlsx" 'default ext
wb.Close
End Sub
I am getting subscript out of range error at following line:
mySheetList(a) = ws.Name
You are sizing the array with ThisWorkbook.Sheets but the loop use ActiveWorkbook.Worksheets. You need the same reference to avoid issues when multiple workbooks are opened.
You're using 4 different references to workbooks:
wb, ThisWorkbook and ActiveWorkbook are not necessarily the same thing. Furthermore, when you use Worksheets without prefixing it with a workbook reference, you're implicitly referencing the Activeworkbook. And, when you use Worksheets.Copy without any arguments, you're implictly creating a new workbook.
Currently, if ThisWorkbook has fewer sheets than original.xlsm, then your array will not be large enough to accommodate indexes larger than the count of sheets in ThisWorkbook. That is what is causing your out of bounds error.
I've adjusted the code. This will open the XLSM, copy the sheets, save the new XLSX workbook, and close the original XLSM, leaving the new XLSX workbook open.
Sub Button1_Click()
Dim wbOriginal As Workbook
Dim wbOutput As Workbook
Set wbOriginal = Workbooks.Open("C:\original.xlsm")
Dim mySheetList() As String
ReDim mySheetList(0 To (wbOriginal.Sheets.Count) - 1)
Dim a As Integer
a = 0
For Each ws In wbOriginal.Worksheets
mySheetList(a) = ws.Name
a = a + 1
Next ws
'Unfortunately, Worksheets.Copy isn't a function, so it doesn't
'return the workbook that it creates, so we have to execute the
'copy, then find the activeworkbook
Worksheets(mySheetList).Copy
Set wbOutput = ActiveWorkbook
'actually save
wbOutput.SaveAs Filename:="ORIGINAL_COPY.xlsx" 'default ext
wbOriginal.Close
End Sub
Why bother with all that looping?
Sub MM()
Dim sourceWB As Excel.Workbook
Set sourceWB = Workbooks.Open("C:\Original.xlsm")
sourceWB.SaveAs "C:\ORIGINAL_COPY.xlsx", FileFormat:=xlOpenXMLWorkook
sourceWB.Close False '// Optional
End Sub
The .SaveAs() method would be far more effective.
As mentioned in other answers, your issue seems to be with wb, ActiveWorkbook and ThisWorkbook being used interchangeably when they are actually different things.
wb is a workbook object that has been set to "C:\original.xlsm". It will always refer to that workbook unless you close the workbook, empty the object, or assign a new object to it.
ActiveWorkbook refers to the workbook that is currently active in Excel's forefront window. (i.e. The workbook you can see on your screen)
ThisWorkbook refers to the workbook in which the currently executing code belongs to. To quickly explain the difference:
Workbook A is the only workbook open, and has some code in to open another workbook (let's call it Workbook B).
At the moment, Workbook A is the ActiveWorkbook.
The code in workbook A starts running, workbook A is now the ActiveWorkbook and ThisWorkbook (because the running codes resides in this workbook)
The code opens Workbook B, which naturally opens in the forefront of Excel. Now Workbook B is the ActiveWorkbook and Workbook A is still the ThisWorkbook
Hopefully that clears it up a bit for you...

Can I copy a sheet to a new workbook if it's hidden

So maybe I'm just not getting something here, but I have a hidden worksheet that list several columns based on other hidden sheets. I'm trying to minimize user intervention... :-)
I want to copy Hidden sheet 1 into a brand new workbook as an available sheet with the aforementioned values. Code that works when hiddensheet is visible:
Dim wbNew As Workbook
Application.DisplayAlerts = False
Worksheets("HiddenSheet").Copy
Set wbNew = ActiveWorkbook
With wbNew
With .Worksheets(1).UsedRange
.Value = .Value
End With
.SaveAs ThisWorkbook.Path & "\"
.Close True
End With
So I'd like to still copy the sheet to a new workbook....just want to do it with the sheet hidden.
Any thoughts?
Absolutely place this line:
Worksheets("HiddenSheet").Visible = xlSheetVisible
before this line:
Worksheets("HiddenSheet").copy
is is impossible to copy a hidden sheet to a new workbook
the new workbook would only have 1 sheet (hidden), but every wb needs at least one visible sheet
if you create a visible sheet and copy your hidden sheed later into it, it works
Sub Makro1()
Dim wbNew As Workbook
Set wbNew = Workbooks.Add
ThisWorkbook.Sheets("Hidden Sheet").Copy Before:=wbNew.Sheets(1)
End Sub
try it :)

Opening a workbook with VBA/macro is making it read only?

I would like my code to open a workbook (always the same one), detect the first free row, write to just two cells in that row, and then save/close the workbook. This seems like a simple problem, but the macro seems to be opening a copy of the file, and then locking it for editing.
Can you see any errors in my open code? I know that the file opens and that the row search works, but then it 1. never writes to the cells, and 2. locks the file.
Function WriteToMaster(Num, Path) As Boolean
'Declare variables
Dim xlApp As Excel.Application
Dim wb As Workbook
Dim ws As Worksheet
Dim infoLoc As Long
Set xlApp = New Excel.Application
'Specifies where the Master Move Key is stored
Set wb = xlApp.Workbooks.Open("DOC LOCATION")
Set ws = wb.Worksheets("Sheet1")
'Loop through cells, looking for an empty one, and set that to the loan number
infoLoc = firstBlankRow(ws)
MsgBox "First blank row is " & infoLoc & ". Num is " & Num
ws.Cells(infoLoc, 1).Value = Num
ws.Cells(infoLoc, 2).Value = Path
'Save, close, and quit
wb.Save
wb.Close
xlApp.Quit
'Resets the variables
Set ws = Nothing
Set wb = Nothing
Set xlApp = Nothing
'pieces of function from http://p2p.wrox.com/vb-how/30-read-write-excel-file-using-vb6.html
End Function
Thank you again, stackoverflow <3
Do you need to open a new excel app just to open a workbook?
Can't you just do something like this:
Sub Macro1()
Dim wkb As Workbook
Workbooks.Open Filename:="\User Documents$\bob\My Documents\workbook_open_example.xlsx"
Set wkb = Workbooks("workbook_open_example.xlsx")
End Sub