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 would like to "Save" the previous info from the cell in a Threaded Comment when i change the value.
This script does that if a cell is empty. If a cell is not empty, then i would like it to save the last value in a threaded comment, not replacing the old comment, but making it into a discussion like it is supposed to be.
Can anybody help me with that? Attached is my code that makes a threaded comment.
Private Sub Worksheet_Change(ByVal Target As Range)
Const sRng As String = "A5:AQ155" ' change as required
Dim sOld As String
Dim sNew As String
Dim sCmt As String
Dim iLen As Long
If Not Intersect(Target, Me.Range(sRng)) Is Nothing Then
Application.EnableEvents = False
With Target
sNew = .Value2
Application.Undo
sOld = .Value2
.Value2 = sNew
Application.EnableEvents = True
sCmt = "Sist endra: " & Format$(Now, "dd Mmm YYYY hh:nn:ss") & " av " & Application.UserName & Chr(10) & "Tidligere info: " & sOld
If .CommentThreaded Is Nothing Then
.AddCommentThreaded sCmt
Else
.AddCommentThreaded sCmt
End If
With .CommentThreaded.Shape.TextFrame
.AutoSize = True
.Characters(Start:=iLen + 1).Insert IIf(iLen, vbLf, "") & sCmt
End With
End With
End If
End Sub
Please try this code. It should just about do what you want although it uses the Note rather than the Comment. The new "Note" equals and replaces the former "Comment". Soo how you like it.
Private Sub Worksheet_Change(ByVal Target As Range)
' 199
Const sRng As String = "A5:AQ155" ' change as required
Dim sOld As String
Dim sNew As String
Dim sCmt As String
Dim iStart As Integer ' first character position
Dim iEnd As Integer ' lastcharacter position
If Not Intersect(Target, Range(sRng)) Is Nothing Then
Application.EnableEvents = False
With Target.Cells(1)
sNew = .Value2
Application.Undo
sOld = .Value2 ' get previous value
.Value2 = sNew
On Error Resume Next
With .Comment
sCmt = .Text ' get previous Note
.Delete
End With
On Error GoTo 0
If Len(sCmt) Then sCmt = vbLf & sCmt
sCmt = "Sist endra: " & Format$(Now, "dd Mmm YYYY hh:nn:ss") & " av " & _
Application.UserName & Chr(10) & "Tidligere info: " & sOld & sCmt
With .AddComment(sCmt)
Do
iEnd = iEnd + 1
iStart = InStr(iEnd, .Text, " av ", vbTextCompare) + 4
If iStart = 4 Then Exit Do
iEnd = InStr(iStart, .Text, Chr(10))
If iEnd = 0 Then iEnd = Len(.Text)
.Shape.TextFrame.Characters(iStart, iEnd - iStart).Font.Bold = True
Loop
End With
End With
Application.EnableEvents = True
End If
End Sub
The little game at the end which boldens the user name is intended to show how you might identify and modify part of the comment's text.
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
I am new to VBA and have adapted various pieces of code from forums.
The audit trail works great, I wanted it to bring through a unique identifier and column header as well as cell changed due to the main data table being constantly sorted by users. I only wanted changes made to the worksheet entitled 'Main' recorded - I have probably done this in a long-winded manner, but it works well.
My query is a request on how I can adapt it further. On the 'Main' data sheet a user may bring through multiple new records at a time (not a significant amount, anywhere from 1-15 rows of data). The audit trail will bring through the value in column A only for the first record. Is it possible to have it that it would bring through just the value of column A for each of the records when pasted in at the same time?
I am looking to analyse the time difference between the Sales Order being saved as complete and then brought through to my delivery planner spreadsheet.
Option Explicit
Public PriorVal As String
Private Sub Workbook_Open()
Dim NR As Long
With Sheets("AuditLog")
NR = .Range("C" & .Rows.Count).End(xlUp).Row + 1
Application.EnableEvents = False
.Range("A" & NR).Value = Environ("UserName")
.Range("B" & NR).Value = Environ("ComputerName")
.Range("C" & NR).Value = Now
Application.EnableEvents = True
End With
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal sh As Object, ByVal Target As Range)
If IsError(Selection(1).Value) = True Then
PriorVal = "Error"
ElseIf Selection(1).Value = "" Then
PriorVal = "Blank"
Else
PriorVal = Selection(1).Value
End If
End Sub
Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
Dim NR As Long
If sh.Name = "AuditLog" Then Exit Sub 'allows you to edit the log sheet
If sh.Name = "Order data" Then Exit Sub
If sh.Name = "Tables" Then Exit Sub
If sh.Name = "PO prep sheet" Then Exit Sub
If sh.Name = "PO upload sheet" Then Exit Sub
If sh.Name = "Purchase Orders" Then Exit Sub
If sh.Name = "Despatches" Then Exit Sub
If sh.Name = "Comments" Then Exit Sub
If sh.Name = "Late Codes" Then Exit Sub
If sh.Name = "Haulage costs" Then Exit Sub
If sh.Name = "Haulier instruction" Then Exit Sub
If Target.Address = "$R$3" Then Exit Sub
Application.EnableEvents = False
With Sheets("AuditLog")
NR = .Range("C" & .Rows.Count).End(xlUp).Row + 1
.Range("A" & NR).Value = Environ("UserName")
.Range("B" & NR).Value = Environ("ComputerName")
.Range("C" & NR).Value = Now
.Range("D" & NR).Value = sh.Name
.Range("E" & NR).Value = Target.Address
.Range("F" & NR).Value = Cells(5, Target.Column)
.Range("G" & NR).Value = PriorVal
.Range("H" & NR).Value = Target(1).Value
.Range("I" & NR).Value = Cells(Target.Row, 1)
NR = NR + 1
End With
Application.EnableEvents = True
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!