I have two .xlsm workbooks. Only workbook B runs a macro on the other.
Workbook A: Job Closeout Status.xlsm
Workbook B: Weekly Payment Sheet.xlsm
Workbook B has a pivot table where the data source is workbook A.
The macro on wkbk B refreshes the pivot table when opened.
I am getting an out of memory error. I have researched that I should set objects to nothing. However I can't edit the macro. Every time I try to add a line of code it gives the "out of memory" error. Can anyone help me out on how to optimize performance, and resolve this "out of memory" issue? Thanks.
I have also noticed that in Visual Basics App, when I only have wkbk B open, wkbk A appears in my project explorer and the worksheet icons are highlighted blue. Usually I only see workbooks that are open in project explorer.
Here is my code in workbook B:
In ThisWorkbook module:
Option Explicit
Private Sub Workbook_Open()
ThisWorkbook.Worksheets("RETENTION").Unprotect
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim wkb As Workbook
On Error Resume Next
If IsFileOpen("S:\ACCOUNTING\Subcontracts\Job Closeout Tracking\Job Closeout Status.xlsm") Then
GoTo Protect
Else
On Error Resume Next
Set wkb = Workbooks.Open(filename:="S:\ACCOUNTING\Subcontracts\Job Closeout Tracking\Job Closeout Status.xlsm")
ThisWorkbook.RefreshAll
wkb.Close SaveChanges:=False
End If
Protect:
ThisWorkbook.Worksheets("RETENTION").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
In a separate module:
Function IsFileOpen(filename As String)
Dim filenum As Integer, errnum As Integer
On Error Resume Next ' Turn error checking off.
filenum = FreeFile() ' Get a free file number.
' Attempt to open the file and lock it.
Open filename For Input Lock Read As #filenum
Close filenum ' Close the file.
errnum = Err ' Save the error number that occurred.
On Error GoTo 0 ' Turn error checking back on.
' Check to see which error occurred.
Select Case errnum
' No error occurred.
' File is NOT already open by another user.
Case 0
IsFileOpen = False
' Error number for "Permission Denied."
' File is already opened by another user.
Case 70
IsFileOpen = True
' Another error occurred.
Case Else
Error errnum
End Select
End Function
Related
hi can you help figure out how to copy worksheet if it existing, and if it is not will automatically create a new workbook then save as blank. please see my code below I try it in if the file is existing copy the file and if not create a new blank file.
Workbooks.Open path1
Sheets.Select
If Sheets("Draft") = "" Then
Set wb = Workbooks.Add
ActiveWorkbook.SaveAs saveFolder & "\D201\D201.xlsx", FileFormat:=51
ActiveWorkbook.Close
Else
Sheets("Draft").Copy
ActiveWorkbook.SaveAs saveFolder & "\D201\D201.xlsx", FileFormat:=51
Workbooks(file1).Close
ActiveWorkbook.Close
End If
and I've encountered an error it says Subscript out of range
Pretty sure you didn't try real hard there (given debugging the error thrown would have lead you to the obvious error). 😊
Here are two possible ways to test for the existence of sheet with a specific name:
Sub Temp()
''' Two possible ways to determine if a sheet with a specific name exists
''' Both assume you're looking for the sheet in the Active Book
''' There are other ways
''' Sledge hammer approach (very efficient)
Dim lgErr&
On Error Resume Next: Err.Clear
With Sheets("Draft"): End With: lgErr = Err
On Error GoTo 0
If lgErr <> 0 Then
' Sheets("Draft") does not exist in the active workbook
Else
' Sheets("Draft") does exist in the active workbook
End If
''' More subtle approach (just as effective and only marginally less efficient)
Dim in1%
For in1 = 1 To Sheets.Count
If Sheets(in1).Name = "Draft" Then Exit For
Next in1
If in1 > Sheets.Count Then
' Sheets("Draft") does not exist in the active workbook
Else
' Sheets("Draft") does exist in the active workbook
End If
End Sub
Notes:
The 1st approach if often used by people confident of their vba skills.
The risk is that a coding error between On Error Resume Next and On Error GoTo 0 could result in and invalid conclusion.
The 2nd approach does not have this same risk.
i usually use a function to test if a sheet exists in my workbook:
Function Feuille_Existe(ByVal Nom_Feuille As String) As Boolean
Dim Feuille As Excel.Worksheet
On Error GoTo Feuille_Absente_Error
Set Feuille = ActiveWorkbook.Worksheets(Nom_Feuille)
On Error GoTo 0
Feuille_Existe = True
Exit Function
Feuille_Absente_Error:
Feuille_Existe = False
End Function
Put this on top of your module and when you need it in your code :
If Feuille_Existe("XXX") Then
'do what you want'
End If
I want to close the active macro workbook inside the Userform_Terminate event. The problem I am facing is that, a ghost window of excel application lingers on even after workbook has been closed.
Have tried most of the suggested ways, I could get my hands on (described in detail in the code snippet) but to no avail. If anybody can help, much grateful.
NOTE: Have released almost all excel related objects from memory by setting it to nothing.
Code :
Private Sub UserForm_Terminate()
' Application.DisplayAlerts = False ' The excel ghost window lingers on
' ThisWorkbook.Close , False
' Application.DisplayAlerts = True
'
' Application.DisplayAlerts = False ' The excel ghost window lingers on
' ThisWorkbook.Saved = True
' ThisWorkbook.Close , False
' Application.DisplayAlerts = True
' Application.DisplayAlerts = False 'The excel ghost window lingers on.
' ThisWorkbook.Close , False
' Application.Quit
' Application.DisplayAlerts = True
Application.DisplayAlerts = False 'Ghost window is closed but also kills all instances of excel currently open
Application.Quit
Application.DisplayAlerts = True
'NOTE:
'Have released all excel related objects from memory by setting it to nothing, post use.
End Sub
Snap:
Well, your "gost" problem has the next explanation:
An Excel session/instance means the same Application handler. If you open a workbook from the Excel existing interface, it is open in the same instance. Pressing Ctrl + F6 will jump to the next workbook open in the same instance...
If there are open workbooks not seen in the Ctrl + F6 sequence, this only means that they are open in a different instance.
Another instance is open, for instance :), in this way:
Din ExApp as Object
Set ExApp = CreateObject("Excel.Application")
ExApp.Workbooks.add 'without this line, the instance is quit by itself...
Set ExApp = Nothing 'this only releases the memory
You can see more open Excel instances (if they exist) looking in TaskManager and seeing more the one such application (Excel.exe)...
When you close a workbook, and this specific workbook is the single one of the instance, the application Window, what you name a "gost" remains!. If there are some other workbooks open, the so named "gost" window disappears, too.
In order to handle both situations, please try the next approach:
Private Sub UserForm_Terminate()
If Workbooks.Count > OpenWb Then
ThisWorkbook.Close , False
Else
Application.Quit
End If
End Sub
Function OpenWb() As Long
Dim count As Long, wb As Workbook, arr
For Each wb In Workbooks
arr = Split(wb.Name, ".")
If UCase(arr(UBound(arr))) = "XLSB" Then count = count + 1
Next
OpenWb = count + 1
End Function
Quitting the application is done here only because you asked for it... When you try programmatically to open and close many workbooks, it is more efficient to keep the application open. To open a new instance takes time. To open a workbook in an existing instance takes less time... But to do that, your code must find that existing instance:
Sub testExcelInstance()
Dim Ex As Object
On Error Resume Next
Set Ex = GetObject(, "Excel.Application")
If Ex Is Nothing Then
Err.Clear: On Error GoTo 0
Set Ex = CreateObject("Excel.Application")
End If
On Error GoTo 0
Ex.Workbooks.Add 'just doing something after having the Excel instance object
End Sub
Releasing the objects from the memory does not do anything, in terms of the object itself existence. If physically disappears only if you quit it.
I've encountered a strange thing: I've joined three workbooks: Personal Data Tracker, Global Tracker and the workbook with pivots and charts. The logic is as it follows: the user clicks on a button after the work is finished so the data is copied to the GL Tracker. Once the change event is triggered in the GL Tracker Table, the last workbook opens, the pivot is refreshed upon the open vent and the wb is closed.
Everything seems to be working fine, however when I run the macro live, at the very end I get an error message about
"Application-defined or object-defined error".
Only OK and Help button displayed, it doesn't make the VBE Open so I could debug it.
Would anyone know what it may be happening even if the whole chain works fine?
Thank you.
Code from the Personal Tracker:
Sub test()
Dim path As String
Dim wb As Workbook
path = ThisWorkbook.path & "\Dest.xlsm"
Application.ScreenUpdating = False
ThisWorkbook.Sheets("Total").Range("R1").Value = Date
Range("R1").Font.Color = VBA.ColorConstants.vbWhite
Worksheets("TOTAL").Range("B2:B13").Copy
On Error GoTo Handler
Workbooks.Open (path)
On Error GoTo 0
Set wb = Workbooks("Dest")
Worksheets("Sheet1").Range("B2").PasteSpecial Paste:=xlPasteValues
Exit Sub
Handler:
MsgBox "Someone else is saving their data at the moment." & vbNewLine & _
"Please try in a few seconds"
End Sub
Code from the GL Tracker:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim MRange As Range
Dim wbPivot As Workbook
Dim pt As PivotTable
Dim ws As Worksheet
Dim Name As String
Dim answer As VbMsgBoxResult
Set MRange = ThisWorkbook.Sheets(1).Range("Table1")
Name = Application.UserName
Application.ScreenUpdating = False
If Not Intersect(Target, MRange) Is Nothing Then
Application.EnableEvents = True
Set wbPivot = Workbooks.Open("C:\Users\jakub\Desktop\Excel - various\Pivot.xlsm")
End If
'refresh
For Each ws In wbPivot.Worksheets
For Each pt In ws.PivotTables
pt.PivotCache.Refresh
pt.Update
pt.RefreshTable
Next
Next
'saving
Application.ScreenUpdating = True
If Application.UserName <> "Jakub Tracz" Then
MsgBox "User not authorised. Workbook will be closed."
wbPivot.Close True
ThisWorkbook.Close True
Else
answer = MsgBox(Prompt:="Do you want to save and close the workbook?", _
Buttons:=vbYesNo + vbQuestion)
Select Case answer
Case vbYes
wbPivot.Close True
ThisWorkbook.Close True
Case vbNo
MsgBox "Welcome, " & Application.UserName
End Select
End If
End Sub
I'm going to give you a proof of concept code as an example for you to use. This will not exactly answer your question with code you can just copy/paste, but you will be able to use this to put it together the way you want it to work instead of me making assumptions about many things and restructuring it myself.
This simply demonstrates how to use a workbook object variable in one routine that can reference another workbook, and how to make changes to that 2nd workbook and save/close it.
Sub Tracker_Update()
Dim wbPivot as Workbook
' open the workbook
Set wbPivot = Workbooks.Open("C:\Users\jakub\Desktop\Excel - various\Test.xlsx")
' optionally make it hidden
wbPivot.Visible = False
With wbPivot
' pretend this code updates the pivot table
.Worksheets(1).Range("A1") = "hello world"
' Close and save it
.Close True
End With
' optionally clear the variable
' this is not really needed in VBA, but if you eventually
' start using VB.NET with Excel as a COM object,
' you will want to know how to do this part when you are done
Set wbPivot = Nothing
End Sub
I think you will like this approach in the end much better in the end anyway, as the code isn't scattered around so much in different places. Easier to debug later, and easier for someone else to understand what you are doing if and when you leave the company.
I have two workbooks on a shared network drive:
Workbook A (Table)
Workbook B (Pivot Table -Connected to source Workbook A)
I'm trying to, when Workbook B is opened, run macro and do this:
Unprotect a certain worksheet on Workbook B
If workbook A is Open, refresh data connections on workbook B
If workbook A is closed, open workbook A and refresh data connections on workbook B, then close workbook A.
Protect a certain worksheet on Workbook B
The code below works as intended in most scenarios when testing so far, but if someone else tries to open workbook B on their computer when someone else has Workbook A opened on another computer, it opens workbook A as a read-only file and keeps it open on their computer. I need it to close on their computer, and keep the initial one open that's on the other computer.
Public Sub RefreshPvt()
ThisWorkbook.Worksheets("Sheet1").Unprotect
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim wkb As Workbook
If IsFileOpen("S:\\Testing\Job Closeout Status Test.xlsx") Then
ThisWorkbook.RefreshAll
Else
Set wkb = Workbooks.Open(filename:="S:\\Testing\Job Closeout Status Test.xlsx")
ThisWorkbook.RefreshAll
wkb.Close SaveChanges:=False
End If
ThisWorkbook.Worksheets("Sheet1").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Function IsFileOpen(filename As String)
Dim filenum As Integer, errnum As Integer
On Error Resume Next ' Turn error checking off.
filenum = FreeFile() ' Get a free file number.
' Attempt to open the file and lock it.
Open filename For Input Lock Read As #filenum
Close filenum ' Close the file.
errnum = Err ' Save the error number that occurred.
On Error GoTo 0 ' Turn error checking back on.
' Check to see which error occurred.
Select Case errnum
' No error occurred.
' File is NOT already open by another user.
Case 0
IsFileOpen = False
' Error number for "Permission Denied."
' File is already opened by another user.
Case 70
IsFileOpen = True
' Another error occurred.
Case Else
Error errnum
End Select
End Function
if you run ThisWorkbook.RefreshAll on workboook B in the immediate window does it work?
You could also make XLApp.Visible = true to see whether or not it's opening
I think you should be using something more like:
Dim pt As PivotTable
For Each pt In ActiveSheet.PivotTables
pt.RefreshTable
Next pt
To do the whole workbook you could use:
Sub AllWorkbookPivots()
Dim pt As PivotTable
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
For Each pt In ws.PivotTables
pt.RefreshTable
Next pt
Next ws
End Sub
Microsoft Office tracks those locks using files that are created in the same directory as the original file. The document filename.xlsx gets a temporary lock file: ~$filename.xlsx. If the document is in use, other user/macro opens the document as read-only. It's by design.
We might try to use Shared workbook feature of Excel, but there are some limitations.
For more detail information, please refer to the following link:
https://support.office.com/en-za/article/Use-a-shared-workbook-to-collaborate-79bd9dee-1aa3-49b5-bc27-a1ad28ffcbce
As mentioned here: https://social.technet.microsoft.com/Forums/ie/en-US/c1b179e1-ec4a-4ab9-abf4-21dc8b0c9326/vba-excel-to-excel-data-connection-it-opens-the-source-file-at-refresh?forum=excel
Is there a simple way to check whether a particularly-named spreadsheet is open in the current Excel session, from VBA?
Dim wBook As Workbook
'Check that Summary worksheet is available for update.
on error goto ErrHandler
Set wBook = Workbooks("CommittedSummary.xls")
If wBook Is Nothing Then
msgbox("Not Open")
Else 'It is open
MsgBox("The 'CommittedSummary.xls' workbook is already in use and
cannot be updated. Please try again when the workbook Is available", _
vbCritical, "Committed Request Edit") : exit sub
End If
errhandler: msgbox("Workbooks is already open"):exit sub
Use error handling as below
Sub Working()
Dim Wb As Workbook
Dim strFile As String
strFile = "X.xls"
On Error Resume Next
Set Wb = Workbooks(strFile)
On Error GoTo 0
If Not Wb Is Nothing Then
MsgBox strFile & " is open in this Excel instance"
Else
MsgBox strFile & vbNewLine & " is Closed in this Excel instance", vbCritical
End If
End Sub
Don't use On Error Resume Next
Just because the code will crashes at that line doesn't mean the workbook is not actually open. It just means your code crashed.
If you have two instances of Excel.Application each instance with have a workbooks collection. And might not be looking in the right workbooks collection. Then your code will crash. There could be other reasons why your code crashes.
Don't use Error handers in the normal flow of your code it's bad programming and it'll lead to problems. Error handling is for problems that are unforeseen.