Closing excel workbook after defined period of time using VBA

[BoardBmelloW]

Hi All,

I have been trying to shut down a worksheet after a defined period of time, with a few rules attached to it. I can get the worksheet to close, but cant get the rules that i need it to do to work!

In basic i need:

1. The workbook/sheet to close after defined period of time, if possible to also show a timer box.
2. Before it closes it i need it to follow the same process as the VBA program already in place, as i need the data that has been filled in transfered and saved on another workbook and then the active sheet wiped before it closes. (Which is what the existing VBA program is doing when they hit a submit button)

What it is in short, is a test that is timed and closes after the time runs out and the scores are transfered onto another workbook which records the scores for safe keeping.

Below is what i already have, i have removed the VBA program for the timer that i'd been working on:

Microsoft Excel Objetcs:
Sheet 1 (Quiz)
Sheet 2 (Knowledge Check)
ThisWorkBook
Module 1

Under "Sheet 1" i have:


Private Sub TransferData()

Set sht1 = ThisWorkbook.Sheets("Quiz")
Set sht2 = ThisWorkbook.Sheets("Knowledge Check")

Dim x As Workbook
Dim y As Workbook

End Sub
Private Sub CommandButton1_Click()
Sheets("Knowledge Check").Range("A2:Z2").Copy
Set y = Workbooks.Open("P:\Woodstock\PRODUCTION\N.Prentice\Training data.xlsx")
y.Sheets("Scores").Cells(Rows.Count, "A").End(xlUp).Offset(1). _
PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ChDir "P:\Woodstock\PRODUCTION\N.Prentice"
Workbooks("Training Data.xlsx").Save
Workbooks("Training Data.xlsx").Close
Sheets("Quiz").Range("E4").Value = ""
Sheets("Quiz").Range("E6").Value = ""
Sheets("Quiz").Range("D261:D270").Value = ""
Sheets("Quiz").Range("E283:I283").Value = ""
Sheets("Quiz").Range("E292:I292").Value = ""
Sheets("Quiz").Range("E301:I301").Value = ""
Sheets("Quiz").Range("E310:I310").Value = ""
Sheets("Quiz").Range("E323:I323").Value = ""
Sheets("Quiz").Range("E332:I332").Value = ""
Sheets("Quiz").Range("G341").Value = ""
ActiveSheet.CheckBoxes.Value = False
ActiveWindow.ScrollRow = 1
Workbooks("Edited Quiz.xlsm").Save
Application.Quit
End Sub

And under "ThisWorkBook" i have:


Private Sub Workbook_Activate()
Application.ScreenUpdating = False
Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",False)"
Application.DisplayFormulaBar = False
Application.DisplayStatusBar = Not Application.DisplayStatusBar
ActiveWindow.DisplayWorkbookTabs = False
Application.ScreenUpdating = True
End Sub
'Private Sub Workbook_Deactivate()
'Application.ScreenUpdating = False
'Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",True)"
'Application.DisplayFormulaBar = True
'Application.DisplayStatusBar = True
'ActiveWindow.DisplayWorkbookTabs = True
'Application.ScreenUpdating = True
'End Sub

I have nothing under "Sheet 2" or "Module 1" ("Sheet 2" is where the data is transfered from to the other workbook)

Anyhelp would be greatly appreciated, the help so far has been excellent and have recommended this site to others!

Kind Regards

Neil

 

[hippiehacker]

This is workbook event code.

Option Explicit

'-----------------------------------------------------------------
Private Sub Workbook_Open()
'-----------------------------------------------------------------
    nElapsed = TimeSerial(0, 5, 0) '5 minutes
    'start a timer to countdown inactivity
    Application.OnTime Now + nElapsed, "CloseWB"
End Sub

Put this code in a standard code module

Option Explicit

Public nElapsed As Double

'-----------------------------------------------------------------
Sub CloseWB()
'-----------------------------------------------------------------
    ThisWorkbook.Save
     ThisWorkbook.Close
End Sub

 

[BoardBmelloW]

Hi Thanks for that,

Had to modify the second partt a little bit to do what i needed it to do, but thank you for pointing me in the right direction all is now working!

Much appreciated!