VBA to Track any Formula Edits for all Sheets

eliz

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

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.

erik.van.geit

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832
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
Code:
    With shtChangeLog
        If .Cells(rwIndex, 1) = "" Then
        .Cells(rwIndex, 1) = Now()
        '...other code same way
        End With
    End If
to get more structure
 

Forum statistics

Threads
1,141,070
Messages
5,704,112
Members
421,327
Latest member
Msh

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top