VBA Log Changes to Fomulas Edits that occur on all Sheets

eliz

New Member
Joined
Sep 12, 2006
Messages
46
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
 

Some videos you may like

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)

Watch MrExcel Video

Forum statistics

Threads
1,113,793
Messages
5,544,315
Members
410,602
Latest member
lidovi
Top