how to auto save and close excel sheet

Hi I have implemented break  tracker in organisation ..but some of the user open the tracker but forget to close it and lock the system and leave..this is creating problem for others to punch in…i want some vb code which save the excel and auto close after certain timings.. here is the code.   this workbook code

<

Public myRao As Boolean
Dim vOldVal

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

Dim bBold As Boolean

If Target.Cells.Count > 1 Then Exit Sub

On Error Resume Next

With Application

.ScreenUpdating = False

.EnableEvents = False

End With

If IsEmpty(vOldVal) Then vOldVal = “Empty Cell”

bBold = Target.HasFormula

With Sheet1

‘.Unprotect Password:=”extn@123″

If .Range(“A1”) = vbNullString Then

.Range(“A1:E1”) = Array(“CELL CHANGED”, “OLD VALUE”, _
“NEW VALUE”, “TIME OF CHANGE”, “DATE OF CHANGE”, “USERNAME”)

End If

With .Cells(.Rows.Count, 1).End(xlUp)(2, 1)

.Value = Target.Address

.Offset(0, 1) = vOldVal

With .Offset(0, 2)

If bBold = True Then

.ClearComments

.AddComment.Text Text:=”OzGrid.com:” & Chr(10) & “” & Chr(10) & _
“Bold values are the results of formulas”

End If

.Value = Target

.Font.Bold = bBold

End With

UserName = Environ(“USERNAME”)

.Offset(0, 3) = Time

.Offset(0, 4) = Date

.Offset(0, 5) = UserName

End With

.Cells.Columns.AutoFit

‘ .Protect Password:=”extn@123″

End With

vOldVal = vbNullString

With Application

.ScreenUpdating = True

.EnableEvents = True

End With

On Error GoTo 0

End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

vOldVal = Target

End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
‘Run from “ThisWorkbook” module!
If myRao = True Then Exit Sub
Application.DisplayAlerts = False
Cancel = True
MsgBox “The X is disabled,please use the Save & Close button”, vbCritical, “Error”
End Sub
Sub SaveAndClose()
‘Run from “ThisWorkbook” module!
myRao = True
ActiveWorkbook.Close Savechanges:=True
Application.DisplayAlerts = False
ActiveWindow.Close False
End Sub

>

above is workbook code

 


 

below is sheet code

<

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range(“B2:B40000”)) Is Nothing Then
Cancel = True
Target.Offset(, 0).Value = Environ(“username”)
ElseIf Not Intersect(Target, Range(“A2:A40000”)) Is Nothing Then
Target.Value = Date
Cancel = True
ElseIf Not Intersect(Target, Range(“C2:D40000”)) Is Nothing Then
Target.Value = Time
Cancel = True
End If
End Sub

>

Top Contributor Asked 4 hours ago in VBA.
Add Comment
0 Answer(s)
  • Found this useful?

    Please share using the share button above.

    If you found the answer is best answer for your question, Please mark as 'best answer' by clicking on the right tick mark icon at the left side of the answer.

    Found the answer useful and wants to credit the user, then vote the answer (vote up).

  • Your Answer

    By posting your answer, you agree to the privacy policy and terms of service.