I'm working on an audit trail in Excel. I want to log the time and the worksheet where the changes have been made.
Dim PreviousValue
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Value <> PreviousValue Then
Sheets("log").Cells(65000, 1).End(xlUp).Offset(1, 0).Value = _
Application.UserName & " changed cell " & Target.Address _
& " from " & PreviousValue & " to " & Target.Value
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
PreviousValue = Target.Value
End Sub
try this
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Value <> PreviousValue Then
Sheets("log").Cells(65000, 1).End(xlUp).Offset(1, 0).Value = _
Application.UserName & " changed cell " & Target.Address _
& " from " & PreviousValue & " to " & Target.Value & " from sheet " & ActiveSheet.Name & " at " & Time
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
PreviousValue = Target.Value
End Sub
Related
I have written the below code in excel vba to log changes made in sheets to the change log sheet. I want to disable that sub if a check box is checked.
This code works perfectly for what I need it to do, just need to figure out a sub that does not allow this to run if a box is checked so every change is not being logged when necessary.
'declare global variable
Dim oldValue As String
Dim oldAddress As String
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'declare variables for individual sheets
Dim sheet1 As String
NSWCCDFY22M = "Sheet 1"
Dim sheet2 As String
NSWCCDFY23M = "Sheet 2"
Dim sheet3As String
NSWCCDLSW = "Sheet 3"
'Logs change for any sheet that isnt the log itself (address, values, user, date/time, hyperlink, note)
If ActiveSheet.Name <> "ChangeLog" Then
Application.EnableEvents = False
Sheets("ChangeLog").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = ActiveSheet.Name & " – " & Target.Address(0, 0)
Sheets("ChangeLog").Range("A" & Rows.Count).End(xlUp).Offset(0, 1).Value = oldValue
Sheets("ChangeLog").Range("A" & Rows.Count).End(xlUp).Offset(0, 2).Value = Target.Value
Sheets("ChangeLog").Range("A" & Rows.Count).End(xlUp).Offset(0, 3).Value = Environ("username")
Sheets("ChangeLog").Range("A" & Rows.Count).End(xlUp).Offset(0, 4).Value = Now
'hyperlink to specific sheet
If ActiveSheet.Name = Sheet 1 Then
Sheets("ChangeLog").Hyperlinks.Add Anchor:=Sheets("ChangeLog").Range("A" & Rows.Count).End(xlUp).Offset(0, 5), Address:="", SubAddress:="'" & Sheet 1 & "'!" & oldAddress, TextToDisplay:=oldAddress
ElseIf ActiveSheet.Name = Sheet 2 Then
Sheets("ChangeLog").Hyperlinks.Add Anchor:=Sheets("ChangeLog").Range("A" & Rows.Count).End(xlUp).Offset(0, 5), Address:="", SubAddress:="'" & Sheet 2 & "'!" & oldAddress, TextToDisplay:=oldAddress
ElseIf ActiveSheet.Name = Sheet 3 Then
Sheets("ChangeLog").Hyperlinks.Add Anchor:=Sheets("ChangeLog").Range("A" & Rows.Count).End(xlUp).Offset(0, 5), Address:="", SubAddress:="'" & Sheet 3 & "'!" & oldAddress, TextToDisplay:=oldAddress
End If
'input box for note
Dim commentChange As String
commentChange = InputBox("Please enter a note for this change.", "Logging")
Sheets("ChangeLog").Range("A" & Rows.Count).End(xlUp).Offset(0, 6).Value = commentChange
'if input box is not filled in
If LenB(commentChange) = 0 Then
MsgBox "You must enter a note for the change you've just made." & vbCrLf & " " & vbCrLf & "You will be taken to the Change Log to add a note and can navigate back to this sheet using the link associated with your change.", vbExclamation, "Change Log Required Actions"
Sheets("ChangeLog").Select
'go to log if a note is not put in
Dim lRow As Long
Dim lColumn As Long
lRow = Range("A1").End(xlDown).Row
lColumn = Range("A1").End(xlToRight).Column
Cells(lRow, lColumn).Select
Dim OutPut As Integer
'infobox when taken to log
OutPut = MsgBox("1. Please enter a note for the change you've just made." & vbCrLf & " " & vbCrLf & "2. Click the link in the 'Link' Column to return to the previous sheet where the change was made.", vbInformation, "Change Log Required Actions")
End If
Sheets("ChangeLog").Columns("A:G").AutoFit
Application.EnableEvents = True
End If
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Count = 1 Then
oldValue = Target.Value
End If
oldAddress = Target.Address
End Sub
Here is my code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
Dim ws As Worksheet
For Each c In Intersect(Target, Range("F9:N46"))
If c.Comment Is Nothing And c.Value <> "" Then
With c.AddComment
.Visible = False
.Text Application.UserName & ":" & Date & " - " & c.Value
End With
ElseIf Not c.Comment Is Nothing And c.Value <> "" Then
c.Comment.Text Application.UserName & ":" & Date & " - " & c.Value & vbNewLine & c.Comment.Text
End If
Next
End Sub
The problem is that if I edit a cell that is not in my defined range I get an error like this:
How can I make this work for cell F9:N46 only?
I solved it by adding an If statement as shown below:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
Dim ws As Worksheet
If Not Intersect(Target, Range("F9:N46")) Is Nothing Then
For Each c In Target
If c.Comment Is Nothing And c.Value <> "" Then
With c.AddComment
.Visible = False
.Text Application.UserName & ":" & Date & " - " & c.Value
End With
ElseIf Not c.Comment Is Nothing And c.Value <> "" Then
c.Comment.Text Application.UserName & ":" & Date & " - " & c.Value & vbNewLine & c.Comment.Text
End If
Next
End If
End Sub
I am looking for a function to print in a comment box, who was the users that changed the data from that cell. What I have for now is this:
Private Sub Worksheet_Change(ByVal Target As Range)
If Range("A" & Target.Row).Value = "" Then GoTo EndeSub
If Not Intersect(Range("C:JA"), Target) Is Nothing Then
On Error GoTo EndeSub
Application.EnableEvents = False
Range("B" & Target.Row) = Now
End If
EndeSub:
Application.EnableEvents = True
End Sub
It "triggers" automatically when someone types something in a cell.
And is printing only the last user name that changed the data, but I want to be some kind of a log, to print all the users. Do you think it is possible?
One way is, insert a New Sheet and name it "Log" and place the two headers like this...
On Log Sheet
A1 --> Date/Time
B1 --> User
Now replace your existing code with this...
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
If Range("A" & Target.Row).Value = "" Then GoTo EndeSub
Dim wsLog As Worksheet
If Not Intersect(Range("C:JA"), Target) Is Nothing Then
On Error GoTo EndeSub
Set wsLog = Sheets("Log")
Application.EnableEvents = False
Range("B" & Target.Row) = Now
wsLog.Range("A" & Rows.Count).End(xlUp).Offset(1, 1) = Environ("UserName")
wsLog.Range("A" & Rows.Count).End(xlUp).Offset(1) = Now
End If
EndeSub:
Application.EnableEvents = True
End Sub
So each time any user makes changes in the target range, the time of change and the user name will be listed on Log Sheet.
Edit:
As per the new setup, these column headers should be there on the Log Sheet.
A1 --> Date/Time
B1 --> User
C1 --> Cell
D1 --> Old Value
E1 --> New Value
Then replace the existing code with the following two codes...
Dim oVal
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
If Range("A" & Target.Row).Value = "" Then GoTo EndeSub
Dim wsLog As Worksheet
If Not Intersect(Range("C:JA"), Target) Is Nothing Then
On Error GoTo EndeSub
Set wsLog = Sheets("Log")
Application.EnableEvents = False
Range("B" & Target.Row) = Now
wsLog.Range("A" & Rows.Count).End(xlUp).Offset(1, 1) = Environ("UserName")
wsLog.Range("A" & Rows.Count).End(xlUp).Offset(1, 2) = Target.Address(0, 0)
wsLog.Range("A" & Rows.Count).End(xlUp).Offset(1, 3) = oVal
wsLog.Range("A" & Rows.Count).End(xlUp).Offset(1, 4) = Target.Value
wsLog.Range("A" & Rows.Count).End(xlUp).Offset(1) = Now
End If
EndeSub:
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
If Not Intersect(Range("C:JA"), Target) Is Nothing Then
oVal = Target
End If
End Sub
In a Public Module
Sub LogChange(Target As Range)
Dim cell As Range, vNew As Variant, vOld As Variant
vNew = Target.value
Application.Undo
vOld = Target.value
Target.value = vNew
With getLogWorksheet
With .Range("A" & .Rows.Count).End(xlUp).Offset(1)
' Array("Date/Time", "UserName", "Worksheet", "Address", "Old Value", "New Value")
.Resize(1, 6).value = Array(Now, Environ("UserName"), Target.Parent.Name, Target.Address(False, False), vOld, vNew)
End With
End With
End Sub
Private Function getLogWorksheet() As Workbook
Dim ws As Worksheet
On Error Resume Next
Set ws = ThisWorkbook.Worksheets("Log")
On Error GoTo 0
If ws Is Nothing Then
Set ws = ThisWorkbook.Worksheets.Add
ws.Visible = xlSheetVeryHidden
ws.Name = "Log"
ws.Range("A1").Resize(1, 6).value = Array("Date/Time", "UserName", "Worksheet", "Address", "Old Value", "New Value")
End If
End Function
In a Worksheet Module
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.CountLarge > 1 Then
Application.Undo
MsgBox "Changing more than 1 cell at a time is prohibited", vbCritical, "Action Undone"
ElseIf Not Intersect(Range("C:JA"), Target) Is Nothing Then
LogChange Target
End If
End Sub
Another bit of code to give you some ideas:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
val_before = Target.Value
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then
MsgBox Target.Count & " cells were changed!"
Exit Sub
End If
If Target.Comment Is Nothing Then
Target.AddComment
existingcomment = ""
Else
existingcomment = Target.Comment.Text & vbLf & vbLf
End If
Target.Comment.Text Text:=Format(Now(), "yyyy-mm-dd") & ":" & vbLf & Environ$("Username") & _
" changed " & Target.Address & " from:" & vbLf & """" & val_before & _
"""" & vbLf & "to:" & vblkf & """" & Target.Value & """"
End Sub
Any time a cell is selected, it stores the cell's existing value in a variable. If the cell is changed, it creates a new comment in the cell (or appends the existing comment if there is one) with the date, username, cell address, and the "before and after" values. This could be super annoying if someone's trying to make a lot of changes, and if there are multiple changes at once, then it will just warn you without creating a comment. I'd suggest you practice on a blank workbook (or a 2nd copy of the one you're working on) in case there are any problems. Be sure to Google any of the properties/methods than you are unfamiliar with, for the sake of learning, and for building a solution to fit your needs!
I'm working on an excel macro that when a part number is scanned into the spreadsheet (in column A), it will automatically open up a PDF document related to that part number. I've got it working for the first cell I want to look at, but am stuck after that. I can add a bunch of "if" statements but there has to be a way to clean it up rather than having hundreds of "if" statements. I need to start in cell A9 and continue to cell A209. Below is what I have so far. Any help in combining these into a simpler code would be greatly appreciated. Thanks in advance!
Private Sub Worksheet_Change(ByVal Target As Range)
Dim varCellvalue As String
If Target.Address = "$A$9" Then
varCellvalue = Range("A9").Value
ThisWorkbook.FollowHyperlink "F:\ITEM PART MASTER\" & varCellvalue & "\" & varCellvalue & " Pack.pdf"
End If
If Target.Address = "$A$10" Then
varCellvalue = Range("A10").Value
ThisWorkbook.FollowHyperlink "F:\ITEM PART MASTER\" & varCellvalue & "\" & varCellvalue & " Pack.pdf"
End If
If Target.Address = "$A$11" Then
varCellvalue = Range("A11").Value
ThisWorkbook.FollowHyperlink "F:\ITEM PART MASTER\" & varCellvalue & "\" & varCellvalue & " Pack.pdf"
End If
This could go on and on, but I figured there has to be a more efficient way of combining these into a simple statement.
With your code, all you need is something quite simple and short (see code below)
Private Sub Worksheet_Change(ByVal Target As Range)
Dim varCellvalue As String
' run your code only if a cell inside the Range("A9:A11") has been changed
If Not Intersect(Target, Range("A9:A11")) Is Nothing Then
varCellvalue = Target.Value
ThisWorkbook.FollowHyperlink "F:\ITEM PART MASTER\" & varCellvalue & "\" & varCellvalue & " Pack.pdf"
End If
End Sub
You could use a Select Case instead
Private Sub Worksheet_Change(ByVal Target As Range)
Dim varCellvalue As String
Select Case Target.Address
Case "$A$9"
varCellvalue = Range("A9")
Case "$A$10"
varCellvalue = Range("A10")
Case "$A$11"
varCellvalue = Range("A11")
End Select
ThisWorkbook.FollowHyperlink "F:\ITEM PART MASTER\" & varCellvalue & "\" & varCellvalue & " Pack.pdf"
Or you could do it faster since you are just inserting the value of the Target into the url.
Private Sub Worksheet_Change(ByVal Target As Range)
ThisWorkbook.FollowHyperlink "F:\ITEM PART MASTER\" & Target & "\" & Target & " Pack.pdf"
If you need to limit this to a few cells, and not every range, then you can use an array to load the target cells, and just check if the target address is in there, then run your code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim varCellvalue As String
Dim targetCells() As Variant
targetCells() = Array("$A$9", "$A$10", "$A$11")
If (UBound(Filter(targetCells, Target.Address)) > -1) Then
'This cell is in your array
Debug.Print Target.Value
ThisWorkbook.FollowHyperlink "F:\ITEM PART MASTER\" & Target.Value & "\" & Target.Value & " Pack.pdf"
End If
End Sub
I search before in this site, but not really found same case with my code. Hope someone here can help me on this.
How to combine two Private sub below?
1st code
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("P:P")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
Dim NR As Long
With Application
.EnableEvents = False
.ScreenUpdating = False
Select Case Target.Value
Case "CLOSED"
NR = Worksheets("Closed").Range("D1500").End(xlUp).Offset(1).Row
Range("B" & Target.Row & ":P" & Target.Row).Copy Worksheets("Closed").Range("B" & NR)
Rows(Target.Row).Delete
Case "Re-handover"
NR = Worksheets("Handover").Range("D1500").End(xlUp).Offset(1).Row
Range("E" & Target.Row & ":O" & Target.Row).Copy Worksheets("Handover").Range("E" & NR)
' Rows(Target.Row).Delete
End Select
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
2nd code
Option Explicit
Public preValue As Variant
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Column <> 15 Then Exit Sub
Target.ClearComments
Target.AddComment.Text Text:="Updated " & Format(Date, "dd mmm yyyy") & " " & Format(Time, "hh:mm") & Chr(10) & "By " & Environ("UserName")
End Sub
thank you very much before
Would this work?
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
*If target.column=15 then
Target.ClearComments
Target.AddComment.Text Text:="Updated " & Format(Date, "dd mmm yyyy") & " " & Format(Time, "hh:mm") & Chr(10) & "By " & Environ("UserName")
else
endif *
If Intersect(Target, Range("P:P")) Is Nothing Then Exit Sub
If Target = "" Then Exit Sub
Dim NR As Long
With Application
.EnableEvents = False
.ScreenUpdating = False
Select Case Target.Value
Case "CLOSED"
NR = Worksheets("Closed").Range("D1500").End(xlUp).Offset(1).Row
Range("B" & Target.Row & ":P" & Target.Row).Copy Worksheets("Closed").Range("B" & NR)
Rows(Target.Row).Delete
Case "Re-handover"
NR = Worksheets("Handover").Range("D1500").End(xlUp).Offset(1).Row
Range("E" & Target.Row & ":O" & Target.Row).Copy Worksheets("Handover").Range("E" & NR)
' Rows(Target.Row).Delete
End Select
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub