MessageBox error and adding it to a Beforesave to an audit trail
Hello everybody,
I need help for a semi-working code I have for an audit trail:
[code]
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 a data entry reason.", "Data Entry Reason")
If .Range("G" & NR).Value = "" Then
Range("G" & NR).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
[code]
1. If I hit cancel or don't enter a reason and hit okay the macro stops working. I need it so that there is a default reason if cancel is selected (or better yet remove cancel as an option) or if the reason is left blank and the macro continues to work.
2. This is not necessary, but if it can be done, I would like to move the reason (but leave the rest {Columns A through F in the Audit Trail sheet} in the worksheet macro) to a Beforesave workbook macro, which would fill in the reason in Column G in the Audit Trail sheet for ALL of the changes recorded in the Audit Trail sheet for ALL of the other worksheets in the workbook (each individual worksheet in the workbook has the above code except the Audit Trail sheet.
It is urgent that I get item 1 corrected, if someone can give me an answer to item 2 also it would be great. Thank you in advance for your help.
Gene
Answer 1 Dim PreviousValue
Answer 1
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
Dim UserInput
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
UserInput = InputBox("Please enter a data entry reason.", "Data Entry Reason")
If UserInput = "" Then
.Range("G" & NR).Value = "My Default Reason"
Else
.Range("G" & NR).Value = UserInput
End If
If .Range("G" & NR).Value = "" Then
Range("G" & NR).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
Hi Vishesh, This works great
Hi Vishesh,
This works great for the 1st question. Is the second question possible, that is moving it to a workbook beforesave so that the reason is only entered once by the user, but entered in all column G cells in the audit trail sheet that had rows with information entered in columns A?
Answer
I got an answer from another site.
If anyone's interested for each worksheet in the workbook (except "Audit Trail") use below modified for your needs):
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 Application
.EnableEvents = False
.ScreenUpdating = False
End With
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
Application.EnableEvents = True
End Sub
Then for the workbook:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim LastRowA As Long
Dim LastRowG As Long
Dim Reason As String
With Sheets("Audit Trail")
LastRowA = .Range("A" & Rows.Count).End(xlUp).Row
LastRowG = .Range("G" & Rows.Count).End(xlUp).Row
End With
If LastRowA <> LastRowG Then
Do
Reason = InputBox("Please enter a data entry reason.", "Data Entry Reason", "New data")
If Reason = "" Then
msg = MsgBox("You MUST provide a data entry reason.", vbCritical, "No Reason Given")
End If
Loop Until Reason <> ""
With Sheets("Audit Trail")
.Unprotect Password:="xyz"
.Range("G" & LastRowG + 1 & ":G" & LastRowA) = Reason
.Protect Password:="xyz"
End With
End If
End Sub