Audit Trail Reason

[eherron]

Hello Everyone,

I have been researching writing an Audit Trail macro for Excel 2007 and between several posts in this web site and others, I came up with a macro that works for my purposes (at bottom), except for one item that might not be p0ssible to perform. I want to add a reason for the change, which preferrably pop-up at the save workbook stage and automatically go into the reason column of the "Audit Trail" worksheet for each change that was performed by that user before saving. My current macro is as follows, but I am not opposed to changing it completely if I need to to accoplish my needs:
Dim PreviousValue As Variant<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o> </o>
Private Sub Worksheet_SelectionChange(ByVal Target As Range)<o></o>
PreviousValue = Target.Value<o></o>
End Sub<o></o>
<o> </o>
Private Sub Worksheet_Change(ByVal Target As Range)<o></o>
Dim NR As Long<o></o>
If Intersect(Target, Range("A1:DW400")) Is Nothing Then Exit Sub<o></o>
With Sheets("Audit Trail")<o></o>
.Unprotect Password:="xyz"<o></o>
NR = .Range("A" & Rows.Count).End(xlUp).Row + 1<o></o>
.Range("A" & NR).Value = Target.Address(False, False)<o></o>
.Range("B" & NR).Value = ActiveSheet.Name<o></o>
.Range("C" & NR).Value = Now<o></o>
.Range("D" & NR).Value = Environ("username")<o></o>
.Range("E" & NR).Value = PreviousValue<o></o>
.Range("F" & NR).Value = Target.Value<o></o>
.Protect Password:="xyz"<o></o>
End With<o></o>
End Sub<o></o>
The reason would go in column G, but as I stated before, I am not married to this macro and will use anyone that works. Thank you in advance for your help.

Gene

 

[doofusboy]

Perhaps adding something like this [or similar] will work for you:

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    Range("G" & Target.Row).Value = InputBox("Please enter an audit reason.", "Audit Trail Reason")
    If Range("G" & Target.Row).Value = "" Then
        Target.Value = ""
        MsgBox "You MUST provide and audit trail reason.", vbCritical, "No Audit Reason Given"
    End If
    Application.EnableEvents = True
End Sub

 

[eherron]

Hello,

I pasted your macro to the end of mine (see total macro below) and I am getting the forllowing error message: "Compile Error: Ambiguous name detected: Worksheet_Change". I am a beginner with writing macros in excel, so if you could check the below macro and see not only how to correct the current error, but if there are any additional issues, it would be appreciated.

Dim PreviousValue As Variant
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
PreviousValue = Target.Value
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim NR As Long
If Intersect(Target, Range("A1:DW400")) Is Nothing Then Exit Sub
With Sheets("Audit Trail")
.Unprotect Password:="xyz"
NR = .Range("A" & Rows.Count).End(xlUp).Row + 1
.Range("A" & NR).Value = Target.Address(False, False)
.Range("B" & NR).Value = ActiveSheet.Name
.Range("C" & NR).Value = Now
.Range("D" & NR).Value = Environ("username")
.Range("E" & NR).Value = PreviousValue
.Range("F" & NR).Value = Target.Value
.Protect Password:="xyz"
End With
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Range("G" & Target.Row).Value = InputBox("Please enter an audit reason.", "Audit Trail Reason")
If Range("G" & Target.Row).Value = "" Then
Target.Value = ""
MsgBox "You MUST provide and audit trail reason.", vbCritical, "No Audit Reason Given"
End If
Application.EnableEvents = True
End Sub

 

[ScottR]

Remove this line from the middle of your code

Private Sub Worksheet_Change(ByVal Target As Range)

That is causing your error, you are attempting to declare a sub within a sub.

Move this line to the start of your code for "internal consistency" for lack of a better name

Application.EnableEvents = False

 

[ScottR]

Oh yes and please surround any code with the CODE tags (hover over the hash button for details). It makes things easier to read and therefore debug.

 

[eherron]

Hi again,

I did some reworking of the macro and I got it to work (see below in colored font), but not the way I need it to work.

1. I need it to display the reason on column G of the "Audit Trail" worksheet, not the current worksheet.
2. I need it ideally to only pop-up when saving the file, not every time data is entered in a cell and then have that reason entered in column G of the "Audit Trail" worksheet in every row that was changed.
3. I need a default reason of "New Data Entry" if a reason isn't typed in.

Dim PreviousValue As Variant
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
PreviousValue = Target.Value
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim NR As Long
If Intersect(Target, Range("A1:DW400")) Is Nothing Then Exit Sub
With Sheets("Audit Trail")
.Unprotect Password:="xyz"
NR = .Range("A" & Rows.Count).End(xlUp).Row + 1
.Range("A" & NR).Value = Target.Address(False, False)
.Range("B" & NR).Value = ActiveSheet.Name
.Range("C" & NR).Value = Now
.Range("D" & NR).Value = Environ("username")
.Range("E" & NR).Value = PreviousValue
.Range("F" & NR).Value = Target.Value
Application.EnableEvents = False
Range("G" & Target.Row).Value = InputBox("Please enter an audit reason.", "Audit Trail Reason")
If Range("G" & Target.Row).Value = "" Then
Target.Value = ""
MsgBox "You MUST provide and audit trail reason.", vbCritical, "No Audit Reason Given"
End If
Application.EnableEvents = True
.Protect Password:="xyz"
End With

End Sub

 

[eherron]

Hi again,

I did some reworking of the macro and I got it to work (see below in colored font), but not the way I need it to work.

1. I need it ideally to only pop-up when saving the file, not every time data is entered in a cell and then have that reason entered in column G of the "Audit Trail" worksheet in every row that was changed.
2. I need a default reason of "New Data Entry" if a reason isn't typed in. With this macro, when the Audit Trail Reason pops up, if cancel is hit, then a pop stating "You MUST provide an audit trail reason". Clicking on "OK" leaves the reason blank.

Dim PreviousValue As Variant
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
PreviousValue = Target.Value
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim NR As Long
Application.EnableEvents = False
If Intersect(Target, Range("A1:DW400")) Is Nothing Then Exit Sub
With Sheets("Audit Trail")
.Unprotect Password:="xyz"
NR = .Range("A" & Rows.Count).End(xlUp).Row + 1
.Range("A" & NR).Value = Target.Address(False, False)
.Range("B" & NR).Value = ActiveSheet.Name
.Range("C" & NR).Value = Now
.Range("D" & NR).Value = Environ("username")
.Range("E" & NR).Value = PreviousValue
.Range("F" & NR).Value = Target.Value
.Range("G" & NR).Value = InputBox("Please enter an audit reason.", "Audit Trail Reason")
If Range("G" & NR).Value = "" Then
Target.Value = ""
MsgBox "You MUST provide an audit trail reason.", vbCritical, "No Audit Reason Given"
End If
Application.EnableEvents = True
.Protect Password:="xyz"
End With

End Sub<!-- / message -->

 

[eherron]

Final Post in this Thread: Please go to new thread titled "Unlocking Cells in 1 worksheet based on Information stored in another worksheet" if interested in how this was resolved!