Forum Discussion
using VBA to undo all changes since last save or open
Currently have no code for undoing. Currently the only code I have is on open or before close. On open is to establish usernames and give a couple people access to get into the file regardless if open by another user and the close is designed to clear the username cells and save if needed, but the problem is that on the on open... given what we are seeing, the only way to ensure other people open the file and it has the username of the first person is to do a "save" when the first person opens the file... but the problem there is if the user currently in the file does not want to save any of their changes, there is no way to clear the cell with their user name and resave the file without saving their changes.
Here is the code I currently have...
Private Sub Workbook_Open()
Application.DisplayAlerts = True
Dim UserOpen As Excel.Worksheet
Set UserOpen = ActiveWorkbook.Worksheets("User")
Worksheets("user").Visible = True
UserOpen.Activate
Range("A4").Select
Range("A4").Value = Environ$("UserName")
Range("A1").Select
If IsEmpty(Range("A1").Value) = True Then
Range("A1").Value = Environ$("UserName")
'disable auto save start
Dim AutoSv As Boolean
If Val(Application.Version) > 15 Then
AutoSv = ActiveWorkbook.AutoSaveOn
If AutoSv Then ActiveWorkbook.AutoSaveOn = False
AutoSv = ActiveWorkbook.AutoSaveOn
End If
'disable auto save end
Worksheets(ActiveSheet.Index + 1).Select
Worksheets("user").Visible = False
ElseIf IsEmpty(Range("A1").Value) = False And Range("A4").Value = "USER1" Then
MsgBox "Be careful", vbInformation, "User in the file: " & Range("A1").Value
Worksheets(ActiveSheet.Index + 1).Select
Worksheets("user").Visible = False
ElseIf IsEmpty(Range("A1").Value) = False And Range("A4").Value = "USER2" Then
MsgBox "Be careful", vbInformation, "User in the file: " & Range("A1").Value
Worksheets(ActiveSheet.Index + 1).Select
Worksheets("user").Visible = False
ElseIf IsEmpty(Range("A1").Value) = False Then
If MsgBox("Open in Read Only?", vbYesNo, "File Already Opened By: " & Range("A1").Value) = 6 Then
Application.DisplayAlerts = False
ThisWorkbook.ChangeFileAccess Mode:=xlReadOnly
Application.DisplayAlerts = True
Worksheets(ActiveSheet.Index + 1).Select
Worksheets("user").Visible = False
Else
Application.DisplayAlerts = False
Application.Quit
End If
End If
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim UserClose As Excel.Worksheet
Set UserClose = ActiveWorkbook.Worksheets("User")
UserClose.Activate
Worksheets("user").Visible = True
Worksheets("user").Select
Range("B1").Select
Worksheets("user").Select
Range("B1").Value = Environ$("username")
If Range("A1") = Range("B1") Then
If MsgBox("Save File?", vbYesNo, "Saving Option") = 6 Then
UserClose.Activate
Worksheets("user").Select
Range("A1").Clear
Worksheets("user").Select
Range("A4").Clear
Worksheets("user").Select
Range("B1").Clear
Worksheets("user").Visible = False
ThisWorkbook.Save
Application.Quit
Else
UserClose.Activate
Worksheets("user").Select
Range("A1").Clear
Worksheets("user").Select
Range("A4").Clear
Worksheets("user").Select
Range("B1").Clear
Worksheets("user").Visible = False
Application.DisplayAlerts = False
Application.Quit
End If
ElseIf Worksheets("user").Range("A1") <> Worksheets("user").Range("B1") Then
Application.DisplayAlerts = False
Application.Quit
End If
End Sub
Check out the Workbook.RejectAllChanges function