Quantcast
Channel: Excel Help Forum - Excel Programming / VBA / Macros
Viewing all articles
Browse latest Browse all 50321

[SOLVED] BeforeClose event not running/working when file is closed through VBA in another file

$
0
0
I have a code in file A that opens several files (B,C,D&E), copies some data from them, then closes the files.
That part of the code works fine, but each of the files that are opened (B,C,D,&E) have a Workbook Open event that causes the file to save automatically every 30 seconds. (I know this is not recommended, but this is what the user wants.) The files also have a Workbook Before Close event that is supposed to stop the timer so the file will close without reopening. These each run fine on their own.
But if I run code A, the workbook Before Close event in file B (C,D, & E) does not seem to run and the files reopen after 30 seconds to save. When I step through the code it works fine and goes through the Before Close event in each file and the files remain closed.

I feel like there is something obvious I am missing. Any help is greatly appreciated. Thanks for taking the time to read my post.

File A code:
Code:

Sub CreateMasterLog()
MSG1 = MsgBox("This will clear the current Pathology Log and replace it with the data on the current provider files.", vbYesNo, "Are you sure you want to continue?")
If MSG1 = vbYes Then

Sheets("Pathology Log").Range("A2:M2").End(xlDown).ClearContents
Dim v As Workbook
Dim w As Workbook
Dim x As Workbook
Dim y As Workbook
Dim z As Workbook
Dim varCellvalue As String
Dim varCellvalue2 As String
Dim varCellvalue3 As String
Dim varCellvalue4 As String
Dim varFilevalue As String
Application.ScreenUpdating = False
varFilevalue = Sheets("File Locations").Range("B2").Value
varCellvalue = Sheets("File Locations").Range("B3").Value
varCellvalue2 = Sheets("File Locations").Range("B4").Value
varCellvalue3 = Sheets("File Locations").Range("B5").Value
varCellvalue4 = Sheets("File Locations").Range("B6").Value

'## Open all workbooks first:
Set v = Workbooks.Open(varFilevalue & varCellvalue4)
Set w = Workbooks.Open(varFilevalue & varCellvalue3)
Set x = Workbooks.Open(varFilevalue & varCellvalue)
Set y = ThisWorkbook
Set z = Workbooks.Open(varFilevalue & varCellvalue2)

'Now, copy what you want from x: and paste to y:
Dim LastRow2 As Long
LastRow2 = x.Worksheets("Pathology Log").UsedRange.Rows.Count
Dim LastRow3 As Long
LastRow3 = w.Worksheets("Pathology Log").UsedRange.Rows.Count
Dim LastRow4 As Long
LastRow4 = v.Worksheets("Pathology Log").UsedRange.Rows.Count
Dim LastRow5 As Long
LastRow5 = z.Worksheets("Pathology Log").UsedRange.Rows.Count

x.Sheets("Pathology Log").Range("A2:M" & LastRow2).Copy
y.Sheets("Pathology Log").Range("A2").PasteSpecial
Application.CutCopyMode = False
z.Sheets("Pathology Log").Range("A2:M" & LastRow5).Copy
y.Sheets("Pathology Log").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial
Application.CutCopyMode = False
w.Sheets("Pathology Log").Range("A2:M" & LastRow3).Copy
y.Sheets("Pathology Log").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial
Application.CutCopyMode = False
v.Sheets("Pathology Log").Range("A2:M" & LastRow4).Copy
y.Sheets("Pathology Log").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial
Application.CutCopyMode = False

'Close x & z:

x.Close
z.Close
w.Close
v.Close

y.Sheets("Filter").Select

End If
End Sub

File B, C, D, & E code posted in ThisWorkbook:
Code:

Private Sub Workbook_Open()
    Call StartTimer
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call StopTimer
End Sub

File B, C, D, & E code posted in Module:
Code:

Public RunWhen As Double
Public Const cRunIntervalSeconds = 30 ' 30 seconds
Public Const cRunWhat = "TheSub"  ' the name of the procedure to run

Sub StartTimer()
    RunWhen = Now + TimeSerial(0, 0, cRunIntervalSeconds)
    Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _
        Schedule:=True
End Sub

Sub TheSub()
    ThisWorkbook.Save
    StartTimer  ' Reschedule the procedure
End Sub

Sub StopTimer()
    On Error Resume Next
    Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _
        Schedule:=False
End Sub


Viewing all articles
Browse latest Browse all 50321

Latest Images

Trending Articles



Latest Images