Is there any way to make this code loop through the sheets.
I do not want code attached to a sheet, I would prefer either a separate module or at least place the code in the ThisWorkbook object.
Notes: the workbook already contains a sheet called "shtchangelog"
'Global Variables
Global TargetValue As Variant
Global CompareRange As String
Global FirstRun As Boolean
Sub UpdateLog(ByVal SheetName As String, ByVal strRange As String, _
ByVal InitialVal As String, ByVal NewVal As String, Optional ByVal strAccepted As String)
Application.ScreenUpdating = False
Dim rwIndex As Long
rwIndex = 1
shtChangeLog.Unprotect ("@ll1@nc3")
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
End If
shtChangeLog.Protect Password:="@ll1@nc3"
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rwIndex As Long
Dim inputBoxReturn As String
Dim inputRequired As Boolean
Dim strPrompt As String
strPrompt = "You are attempting to change a formula to a standard value." & vbCrLf & _
"Please accept this change by typing 'accept' (lowercase) in the box below"
rwIndex = 1
inputRequired = False
'On Error Resume Next
If TargetValue <> Range(CompareRange).Formula Then
If Left(TargetValue, 1) = "=" And Left(Range(CompareRange).Formula, 1) <> "=" Then
strPrompt = "You are attempting to change a formula to a standard value." & _
"Please accept this change by typing 'accept' (lowercase) in the box below:"
inputRequired = True
inputBoxReturn = InputBox(strPrompt, "Formula Change", "")
ElseIf Left(TargetValue, 1) = "=" And Left(Range(CompareRange).Formula, 1) = "=" Then
strPrompt = "You are attempting to change a formula (and its functionality). " & _
"Please accept this change by typing 'accept' (lowercase) in the box below:"
inputRequired = True
inputBoxReturn = InputBox(strPrompt, "Formula Change", "")
End If
If inputRequired And inputBoxReturn = "accept" Then
Call UpdateLog(ActiveSheet.Name, CompareRange, TargetValue, Range(CompareRange).Formula, "ACCEPTED")
ElseIf Not inputRequired Then
Call UpdateLog(ActiveSheet.Name, CompareRange, TargetValue, Range(CompareRange).Formula)
Else
Application.Undo
End If
End If
TargetValue = ActiveCell.Formula
CompareRange = ActiveCell.Address
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
TargetValue = ActiveCell.Formula
CompareRange = ActiveCell.Address
End Sub
I do not want code attached to a sheet, I would prefer either a separate module or at least place the code in the ThisWorkbook object.
Notes: the workbook already contains a sheet called "shtchangelog"
'Global Variables
Global TargetValue As Variant
Global CompareRange As String
Global FirstRun As Boolean
Sub UpdateLog(ByVal SheetName As String, ByVal strRange As String, _
ByVal InitialVal As String, ByVal NewVal As String, Optional ByVal strAccepted As String)
Application.ScreenUpdating = False
Dim rwIndex As Long
rwIndex = 1
shtChangeLog.Unprotect ("@ll1@nc3")
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
End If
shtChangeLog.Protect Password:="@ll1@nc3"
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rwIndex As Long
Dim inputBoxReturn As String
Dim inputRequired As Boolean
Dim strPrompt As String
strPrompt = "You are attempting to change a formula to a standard value." & vbCrLf & _
"Please accept this change by typing 'accept' (lowercase) in the box below"
rwIndex = 1
inputRequired = False
'On Error Resume Next
If TargetValue <> Range(CompareRange).Formula Then
If Left(TargetValue, 1) = "=" And Left(Range(CompareRange).Formula, 1) <> "=" Then
strPrompt = "You are attempting to change a formula to a standard value." & _
"Please accept this change by typing 'accept' (lowercase) in the box below:"
inputRequired = True
inputBoxReturn = InputBox(strPrompt, "Formula Change", "")
ElseIf Left(TargetValue, 1) = "=" And Left(Range(CompareRange).Formula, 1) = "=" Then
strPrompt = "You are attempting to change a formula (and its functionality). " & _
"Please accept this change by typing 'accept' (lowercase) in the box below:"
inputRequired = True
inputBoxReturn = InputBox(strPrompt, "Formula Change", "")
End If
If inputRequired And inputBoxReturn = "accept" Then
Call UpdateLog(ActiveSheet.Name, CompareRange, TargetValue, Range(CompareRange).Formula, "ACCEPTED")
ElseIf Not inputRequired Then
Call UpdateLog(ActiveSheet.Name, CompareRange, TargetValue, Range(CompareRange).Formula)
Else
Application.Undo
End If
End If
TargetValue = ActiveCell.Formula
CompareRange = ActiveCell.Address
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
TargetValue = ActiveCell.Formula
CompareRange = ActiveCell.Address
End Sub