VBA to Track any Formula Edits for all Sheets

[eliz]

A programmer (not an Excel user) created the code below.

The purpose of the code is to automatically log a new row in a Change Log Worksheet every time a user edits a formula. They are actually prompted to type in the word "Accept" so that they are completely aware of the change they are trying to implement. It tracks the original formula as well as the new formula and the date/time the change was made.

Seems kind of complicated, can it be simpler than this?

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

 

[erik.van.geit]

Hi,

Seems kind of complicated, can it be simpler than this?

To be honnest: My first thought was: study and experiment with VBA, check the helpfiles for some items you don't understand. Then the code will "be" simpler into your eyes.

you want to do the same tasks and make it simpler ?
I didn't look in detail but at first glance this seems to be a good job.

perhaps you want to get rid of some messagebox ?

kind regards,
Erik

EDIT: perhaps the programmer delivered more readable layout than you did: please use the CODE-tags when displaying code
he could have added some With ... End With

    With shtChangeLog
        If .Cells(rwIndex, 1) = "" Then
        .Cells(rwIndex, 1) = Now()
        '...other code same way
        End With
    End If

to get more structure