Option Explicit
'
Dim savingNowFlag As Boolean

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
'this code implemented to set PreviousValue to the
'active cell on a non-Audit Trail sheet when that sheet is selected
If Sh.Name <> auditSheetName Then
PreviousValue = ActiveCell.Value
End If
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Cells.Count > 1 Then
MsgBox "Limit your selection to a single cell" 'Prevents clearing more than 1 cell at a time
Target.Cells(1, 1).Select
Exit Sub
End If
PreviousValue = Target.Cells(1, 1).Value
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'Sh refers to the worksheet that the change took place on Target works just like it does in Worksheet_Change() event processing
'it is just specific to the Sh sheet that the change took place on
'
Dim NR As Long
'all of the following deal with monitoring the "Reviewed by..." entries.
Dim auditWS As Worksheet
Dim currentCol As Long
Dim currentRow As Long
Dim sectionFirstRow As Long
Dim examineRange As Range
Dim anyERangeEntry As Range
Dim tempCell As Range

'if the change took place on the Audit Trail worksheet, ignore!!
If Sh.Name = auditSheetName Then
Exit Sub
End If

If Intersect(Target, Sh.Range(watchRange)) Is Nothing Then Exit Sub
'
' this section determines if the change is being made to one of the
' "Interval Reviewed By (Initials)" rows on the sheet
' by using the phrase, we don't have to keep up with rows
' just be sure to use the phrase where needed
'
'while this looks like a lot of code, it is only executed when
'you attempt to make a change to the 'Reviewed by" entries.
If InStr(UCase(Sh.Range("A" & Target.Row)), UCase(reviewPhrase)) > 0 Then
'this IS one of the special rows, determine if the
'make sure that the current user is not the same user
'that made entries into this column previously
'if they are the same, we will erase the entry and
'refuse to accept it or record it.
currentCol = Target.Column
currentRow = Target.Row
'find where this section of entries begins based on finding the
' sectionStartPhrase (STABILITY STUDY:) entry immediately above
' this Reviewed by entry
sectionFirstRow = currentRow - 1
With Sh
Do Until InStr(.Range("A" & sectionFirstRow), sectionStartPhrase) > 0
sectionFirstRow = sectionFirstRow - 1
Loop
End With
Set auditWS = ThisWorkbook.Worksheets(auditSheetName)
'set a reference to the list of worksheet names on the Audit Trail sheet
Set examineRange = auditWS. _
Range(awsWSNameCol & firstAuditEntryRow & ":" & _
auditWS.Range(awsWSNameCol & Rows.Count).End(xlUp).Address)
For Each anyERangeEntry In examineRange
'is the entry regarding this Sh?
If anyERangeEntry = Sh.Name Then
'yes, test if recorded range is in same column and within the proper section
Set tempCell = Range(auditWS.Range(awsCellCol & anyERangeEntry.Row).Value)
If tempCell.Column = currentCol And tempCell.Row > sectionFirstRow And _
tempCell.Row < currentRow Then
'entry is about the same sheet and same column, within the correct section
'test the user entry for name match/mismatch
If auditWS.Range(awsUserCol & anyERangeEntry.Row) = Environ("username") Then
'the names are the same! reject the attempted entry & pop- up this message box
MsgBox "You may not Review entries that you made.", vbOKOnly, "Invalid Reviewer"
Application.EnableEvents = False
Target.ClearContents
'remain in the cell we just cleared
Target.Select
Application.EnableEvents = True
'some housecleaning before exiting
Set anyERangeEntry = Nothing
Set examineRange = Nothing
Set auditWS = Nothing
Set tempCell = Nothing
Exit Sub
End If
End If
End If
Next
End If

'continue on to record the entry
With Application
.EnableEvents = False
.ScreenUpdating = False
End With

With Sheets(auditSheetName)
.Unprotect Password:=auditWSPassword
NR = .Range(awsCellCol & Rows.Count).End(xlUp).Row + 1
.Range(awsCellCol & NR).Value = Target.Address(False, False)
.Range(awsWSNameCol & NR).Value = Sh.Name
.Range(awsDateCol & NR).Value = Now
.Range(awsUserCol & NR).Value = Environ("username")
.Range(awsPrevValCol & NR).Value = PreviousValue
.Range(awsNewValCol & NR).Value = Target.Value
.Protect Password:=auditWSPassword
End With

If PreviousValue = "" Then
With Sheets(auditSheetName)
.Unprotect Password:=auditWSPassword
.Range(awsReasonCol & NR).Value = "New Data"
.Protect Password:=auditWSPassword
End With
Else
'get reason for change from user via UserForm
UserForm1.Show
End If
Application.EnableEvents = True

End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim auditWS As Worksheet
Dim CellListRange As Range
Dim anyCellListed As Range
Dim newTestCell As Range
Dim sName As String
Dim cAddress As String
Dim uName As String

If savingNowFlag Then
savingNowFlag = False ' reset
Exit Sub ' no re-entry while doing it already
End If

Set auditWS = ThisWorkbook.Worksheets(auditSheetName)
If auditWS.Range(awsCellCol & Rows.Count).End(xlUp).Row < firstAuditEntryRow Then
Set auditWS = Nothing
Exit Sub ' no entries on the Audit Trail sheet other than the headers.
End If

Set CellListRange = auditWS.Range(awsCellCol & firstAuditEntryRow & _
":" & auditWS.Range(awsCellCol & Rows.Count).End(xlUp).Address)

Application.ScreenUpdating = False
For Each anyCellListed In CellListRange
If IsEmpty(auditWS.Range(awsLockedCol & anyCellListed.Row)) Then
'Do NOT lock the cell but do add "-" to any other references
'to the same sheet!cell by the same user
'turn off event processing while we make changes
Application.EnableEvents = False
'save sheet name and cell address involved
sName = auditWS.Range(awsWSNameCol & anyCellListed.Row)
cAddress = auditWS.Range(awsCellCol & anyCellListed.Row)
uName = auditWS.Range(awsUserCol & anyCellListed.Row)

If IsEmpty(Worksheets(sName).Range(cAddress)) Then
' change the user id to have a "-" in front of it if it doesn't already
' so that username doesn't match for "can this user audit this data" later.
'make sure the empty cell is unlocked on the report sheet
With Worksheets(auditWS.Range(awsWSNameCol & anyCellListed.Row).Value)
.Unprotect Password:=nonAuditWSPassword
.Range(anyCellListed.Value).Locked = False
.Protect Password:=nonAuditWSPassword
End With
'mark cells on the audit sheet with same username, sheet name, cell address
'with the "-" to allow editing/auditing by that person later.

For Each newTestCell In CellListRange
If auditWS.Range(awsWSNameCol & newTestCell.Row) = sName And _
auditWS.Range(awsCellCol & newTestCell.Row) = cAddress And _
auditWS.Range(awsUserCol & newTestCell.Row) = uName Then
'mark with "-",
If Left(auditWS.Range(awsUserCol & newTestCell.Row), 1) <> "-" Then
auditWS.Unprotect Password:=auditWSPassword
auditWS.Range(awsUserCol & newTestCell.Row) = _
"-" & auditWS.Range(awsUserCol & newTestCell.Row)
auditWS.Protect Password:=auditWSPassword
End If
End If
Next
Else
' DO need to lock it and mark it as locked
If Not IsEmpty(Worksheets(sName).Range(cAddress)) Then
With Worksheets(auditWS.Range(awsWSNameCol & anyCellListed.Row).Value)
.Unprotect Password:=nonAuditWSPassword
.Range(anyCellListed.Value).Locked = True
.Protect Password:=nonAuditWSPassword
End With
'record the locked status on the Audit Trail sheet
With auditWS
.Unprotect Password:=auditWSPassword
.Range(awsLockedCol & anyCellListed.Row) = "Locked"
.Protect Password:=auditWSPassword
End With
End If
End If
'turn event processing back on!
Application.EnableEvents = True
End If
Next

Application.DisplayAlerts = False
savingNowFlag = True
ThisWorkbook.Save
savingNowFlag = False
Application.DisplayAlerts = True

'housekeeping - release objects back to the system for reuse
Set CellListRange = Nothing
Set anyCellListed = Nothing
Set auditWS = Nothing
End Sub

Private Sub Workbook_Activate()
'the _Activate event is triggered when:
' you open the workbook, or you switch back to this workbook after using another workbook that 'is also open.
' the Call ToggleCutCopyAndPaste () is to use the code in Module 1
' the code below, Module 1 and RibbonModule are to disable "Cut", "Copy", etc from all worksheets
' the RibbonModule requires a "customUI.xml" to be save to this file with Custom UI Editor For 'Microsoft Office
'
On Error Resume Next
With Application.CommandBars("Cell")
.Controls("Cut").visible = False
.Controls("Copy").visible = False
.Controls("Paste").visible = False
.Controls("Paste Special...").visible = False
.Controls("Insert...").visible = False
.Controls("Delete...").visible = False
.Controls("Clear Contents").visible = False
.Controls("Filter").visible = False
.Controls("Sort").visible = False
.Controls("Insert Comment").visible = False
'.Controls("Format Cells...").visible = False ' Allows formatting cells when sheets unprotected
.Controls("Pick from drop-down list...").visible = False
.Controls("Name a Range...").visible = False
.Controls("Hyperlink...").visible = False
' .Controls("Look up...").Visible = False
End With
On Error GoTo 0
Call ToggleCutCopyAndPaste(False)
End Sub

Private Sub Workbook_Deactivate()
'the _Deactivate event is triggered when:
' you close the workbook, or you switch to use another workbook that is also open.
'
On Error Resume Next
With Application.CommandBars("Cell")
.Controls("Cut").visible = True
.Controls("Copy").visible = True
.Controls("Paste").visible = True
.Controls("Paste Special...").visible = True
.Controls("Insert...").visible = True
.Controls("Delete...").visible = True
.Controls("Clear Contents").visible = True
.Controls("Filter").visible = True
.Controls("Sort").visible = True
.Controls("Insert Comment").visible = True
.Controls("Format Cells...").visible = True
.Controls("Pick from drop-down list...").visible = True
.Controls("Name a Range...").visible = True
.Controls("Hyperlink...").visible = True
' .Controls("Look up...").Visible = False
End With
On Error GoTo 0
Call ToggleCutCopyAndPaste(True)
End Sub

Private Sub Workbook_Open()
Call ToggleCutCopyAndPaste(False)
Dim myCount As Integer
Dim i As Integer
On Error Resume Next

myCount = Application.Sheets.Count
For i = 2 To myCount
Sheets(i).visible = xlSheetVisible
If i = myCount Then
Sheets(1).visible = xlVeryHidden
End If
Next i
'loop could be rewritten as:
' For i = 2 To myCount
' Sheets(i).visible = xlSheetVisible
' Next i
' Sheet1.visible = xlVeryHidden ' Sheet1 is always [Enable Macro Warning] even if you move
' it in the workbook.

End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim i As Integer
Dim saveActionReply As Integer
Dim auditWS As Worksheet
Dim CellListRange As Range
Dim anyCellListed As Range
Dim newTestCell As Range
Dim sName As String
Dim cAddress As String
Dim uName As String

If ThisWorkbook.Saved Then
'hide the working sheets and display the macro warning sheet, save the file
'again in that state and then actually close the file
Application.ScreenUpdating = False
Application.EnableEvents = False ' don't call the BeforeSave() process
Sheet1.visible = xlSheetVisible
For i = 1 To ThisWorkbook.Sheets.Count
If Sheets(i).Name <> Sheet1.Name Then
Sheets(i).visible = xlSheetHidden
End If
Next
Application.DisplayAlerts = False ' don't ask about overwriting or such
ThisWorkbook.Save
Application.DisplayAlerts = True ' reset
Application.EnableEvents = True
'and now it will fall out of all testing to actually close the workbook
Else
'workbook has unsaved changes, ask whether to save them, close without saving, or cancel the close
'default (just pressing [Enter] is same as [Cancel]).
saveActionReply = _
MsgBox("This workbook has Unsaved Changes. Do you wish to:" & vbCrLf _
& "Save the changes [Yes]," & vbCrLf _
& "Close Without Saving [No], or" & vbCrLf _
& "[Cancel] and keep the workbook open?", _
vbYesNoCancel + vbCritical + vbDefaultButton3, "Save Changes?")
Select Case saveActionReply
Case vbCancel
'chose to cancel, so set Cancel = true
Cancel = True

Case vbNo
Application.ScreenUpdating = False
Application.EnableEvents = False ' don't call the BeforeSave() process
Sheet1.visible = xlSheetVisible
For i = 1 To ThisWorkbook.Sheets.Count
If Sheets(i).Name <> Sheet1.Name Then
Sheets(i).visible = xlSheetHidden
End If
Next
On Error Resume Next
Call ToggleCutCopyAndPaste(True)
If Err <> 0 Then
Err.Clear
End If
On Error GoTo 0 'reset error handling
ThisWorkbook.Saved = True 'make system think it has been saved
Application.EnableEvents = True

Case vbYes
savingNowFlag = True ' prevent _BeforeSave() from responding later.
Set auditWS = ThisWorkbook.Worksheets(auditSheetName)
If auditWS.Range(awsCellCol & Rows.Count).End(xlUp).Row < firstAuditEntryRow Then
'do nothing, as there is no work to do
Else
Set CellListRange = auditWS.Range(awsCellCol & firstAuditEntryRow & _
":" & auditWS.Range(awsCellCol & Rows.Count).End(xlUp).Address)

Application.ScreenUpdating = False
For Each anyCellListed In CellListRange
If IsEmpty(auditWS.Range(awsLockedCol & anyCellListed.Row)) Then
'Do NOT lock the cell but do add "-" to any other references
'to the same sheet!cell by the same user
'turn off event processing while we make changes
Application.EnableEvents = False
'save sheet name and cell address involved
sName = auditWS.Range(awsWSNameCol & anyCellListed.Row)
cAddress = auditWS.Range(awsCellCol & anyCellListed.Row)
uName = auditWS.Range(awsUserCol & anyCellListed.Row)

If IsEmpty(Worksheets(sName).Range(cAddress)) Then
' change the user id to have a "-" in front of it if it doesn't already
' so that username doesn't match for "can this user audit this data" later.
'make sure the empty cell is unlocked on the report sheet
With Worksheets(auditWS.Range(awsWSNameCol & anyCellListed.Row).Value)
.Unprotect Password:=nonAuditWSPassword
.Range(anyCellListed.Value).Locked = False
.Protect Password:=nonAuditWSPassword
End With
'mark cells on the audit sheet with same username, sheet name, cell address
'with the "-" to allow editing/auditing by that person later.
For Each newTestCell In CellListRange
If auditWS.Range(awsWSNameCol & newTestCell.Row) = sName And _
auditWS.Range(awsCellCol & newTestCell.Row) = cAddress And _
auditWS.Range(awsUserCol & newTestCell.Row) = uName Then
'mark with "-",
If Left(auditWS.Range(awsUserCol & newTestCell.Row), 1) <> "-" Then
auditWS.Unprotect Password:=auditWSPassword
auditWS.Range(awsUserCol & newTestCell.Row) = _
"-" & auditWS.Range(awsUserCol & newTestCell.Row)
auditWS.Protect Password:=auditWSPassword
End If
End If
Next
Else
' DO need to lock it and mark it as locked
If Not IsEmpty(Worksheets(sName).Range(cAddress)) Then
With Worksheets(auditWS.Range(awsWSNameCol & anyCellListed.Row).Value)
.Unprotect Password:=nonAuditWSPassword
.Range(anyCellListed.Value).Locked = True
.Protect Password:=nonAuditWSPassword
End With
'record the locked status on the Audit Trail sheet
With auditWS
.Unprotect Password:=auditWSPassword
.Range(awsLockedCol & anyCellListed.Row) = "Locked"
.Protect Password:=auditWSPassword
End With
End If
End If
'turn event processing back on!
Application.EnableEvents = True
End If
Next
Application.EnableEvents = False
Application.DisplayAlerts = False
savingNowFlag = True
ThisWorkbook.Save
savingNowFlag = False
Application.DisplayAlerts = True
Application.EnableEvents = True
'housekeeping - release objects back to the system for reuse
Set CellListRange = Nothing
Set anyCellListed = Nothing
Set auditWS = Nothing
End If
On Error Resume Next
ActiveWorkbook.Save ' save once to prevent 1004 error
Application.EnableEvents = False ' to not trigger WorksheetActivate process
Sheet1.visible = xlSheetVisible
Range("A1").Select
For i = 1 To ThisWorkbook.Sheets.Count
If Sheets(i).Name <> Sheet1.Name Then
Sheets(i).visible = xlVeryHidden
End If
Next i
ActiveWorkbook.Save
Call ToggleCutCopyAndPaste(True)
Application.EnableEvents = True
savingNowFlag = False
End Select
End If
End Sub