That sounds interesting.
Would that require a lot of code?
Right now I am doing something like this...
Sub AutoProtect(bIsOpening)
'reduce screen flicker
Application.ScreenUpdating = False
'show Protection toolbar
If bIsOpening Then Application.CommandBars("Protection").Visible = True
'declare variables
Dim SH As Worksheet
Dim rng As Range
Dim sErrors As String 'for error handlers
On Error Resume Next
'loop through each sheet (Except for ChangeLog), lock formulas, protect sheets
For Each SH In Worksheets
If SH.Name <> "ChangeLog" Then
SH.Unprotect
'error handling
If Err <> 0 Then
If Err.Number <> 1004 Then
sErrors = sErrors & "The sheet named " & SH.Name & " could not be unprotected." & vbCrLf & vbCrLf
End If
End If
If SH.Name <> "changelog" Then
With SH.Cells ' used to say with sh.usedrange
.Locked = False
Set rng = Nothing
Set rng = .SpecialCells(xlCellTypeFormulas)
Err.Clear '//The Err.Clear
'this was throwing an error if there were no
'formula cells on a worksheet.
If Not rng Is Nothing Then
'rng.Font.ColorIndex = 7 'optional changes color of all formulas
If rng.Cells.Count <> 0 Then
rng.Locked = True
End If
'error handling
If Err <> 0 Then
sErrors = sErrors & "The formulas on " & SH.Name & " could not be locked." & vbCrLf & vbCrLf
End If
End If
End With
End If
' allow users certain functionality while worksheet is protected
' user will be able to format cells, adjust columns width and row height
' user will be able to insert rows/columns
' user is only able to delete row/columns that do NOT contain locked cells
' user is only able to sort/filter data range that does NOT contain
' locked cells
SH.Protect AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowInsertingColumns:=True, _
AllowInsertingRows:=True, AllowDeletingColumns:=True, _
AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True
'error handling
If Err <> 0 Then
If Err.Number <> 1004 Then
sErrors = sErrors & "The sheet " & SH.Name & " could not be protected." & vbCrLf & vbCrLf
End If
End If
End If
Next SH
Application.ScreenUpdating = True
'error handling
If sErrors <> "" Then
Dim sModule As String
If bIsOpening Then sModule = "Workbook_Open" Else sModule = "Workbook.BeforeSave"
MsgBox "Some errors occurred in Workbook.BeforeSave: " & vbCrLf & vbCrLf & sErrors, vbInformation, "Errors in Workbook.BeforeSave"
End If
End Sub
Sub UpdateLog(ByVal SheetName As String, ByVal strRange As String, _
ByVal InitialVal As String, ByVal NewVal As String, Optional ByVal strAccepted As String)
'error handler
On Error GoTo err_
'reduce screen flicker
Application.ScreenUpdating = False
'declare variables
Dim rwIndex As Long
Dim sErrorMessage
Dim shtChangeLog As Worksheet
rwIndex = 1
Set shtChangeLog = ThisWorkbook.Sheets("ChangeLog")
shtChangeLog.Unprotect ("ll1nc3")
Do While shtChangeLog.Cells(rwIndex, 1) <> ""
rwIndex = rwIndex + 1
Loop
If shtChangeLog.Cells(rwIndex, 1) = "" Then
shtChangeLog.Cells(rwIndex, 1).Value = Now()
shtChangeLog.Cells(rwIndex, 2).Value = SheetName
shtChangeLog.Cells(rwIndex, 3).Value = strRange
shtChangeLog.Cells(rwIndex, 4).Value = "'" & InitialVal
shtChangeLog.Cells(rwIndex, 5).Value = "'" & NewVal
shtChangeLog.Cells(rwIndex, 6).Value = strAccepted
shtChangeLog.Cells(rwIndex, 7).Value = Environ("USERDOMAIN") & "\" & Environ("USERNAME")
End If
shtChangeLog.Protect Password:="ll1nc3"
Application.ScreenUpdating = True
Exit Sub
'error handler
err_:
sErrorMessage = "ERROR - An error occurred when updating the Change Log. " & vbCrLf & vbCrLf & Err.Description & vbCrLf & vbCrLf & "Please contact the ### service desk at (###) ###-####."
Application.ScreenUpdating = True
MsgBox sErrorMessage, vbCritical, "Critical Error Updating the Change Log!"
End Sub