• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

VBA code to 1)Log changes and 2)Highlight changes of changed cell(Color and comments)

Hi .

I have to track changes to a file that I will be sending to my colleagues to revise.
I tried to google and refer to youtube but I was not able to figure it out so I hope someone can help me revise or improve the code.

1)Log Sheet: now it is only showing the new value (changes). I want to also track the old value. How can I do it ?

Private Sub Workbook_Open()
Dim myName As String
Sheets("LogDetails").Visible = xlSheetVeryHidden
End Sub

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
On Error Resume Next
If Sheets("Logdetails").Visible = xlSheetVisible Then
Sheets("LogDetails").Visible = xlSheetVeryHidden
Else
Sheets("Logdetails").Visible = xlSheetVisible
End If
Target.Offset(1, 1).Select

End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If ActiveSheet.Name <> "LogDetails" Then
Application.EnableEvents = False
Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = ActiveSheet.Name & "-" & Target.Address(0, 0)
Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 1).Value = Target.Value
Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 2).Value = Environ("username")
Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 3).Value = Now
Sheets("LogDetails").Columns("A:D").AutoFit
Application.EnableEvents = True
End If
End Sub



2)I want to highlight the cell that has been changed to a different color so that it can be more easily detected.

Option Compare Text
Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)


Const sRng As String = "A1:AT4000" ' change as required
Dim sOld As String
Dim sNew As String
Dim sCmt As String
Dim iLen As Long
Dim bHasComment As Boolean


With Target(1)
If Intersect(.Cells, Range(sRng)) Is Nothing Then Exit Sub
sNew = .Text
Application.EnableEvents = False
Application.Undo
sOld = .Text
.Value = sNew
Application.EnableEvents = True


sCmt = "Edit: " & Format$(Now, "dd Mmm YYYY hh:nn:ss") & " by " & Application.UserName & Chr(10) & "Previous Text :- " & sOld



If Target(1).Comment Is Nothing Then
.AddComment
Else
iLen = Len(.Comment.Shape.TextFrame.Characters.Text)
End If


With .Comment.Shape.TextFrame
.AutoSize = True
.Characters(Start:=iLen + 1).Insert IIf(iLen, vbLf, "") & sCmt
End With
End With
End Sub
 
Hi ,

For your second question , you can try changing your code :
Code:
With Target(1)
     If Intersect(.Cells, Range(sRng)) Is Nothing Then Exit Sub
        sNew = .Text
        Application.EnableEvents = False
        Application.Undo
        sOld = .Text
        .Value = sNew
        Application.EnableEvents = True
by including the following line after the last statement :

.Interior.Color = vbRed

Since you have a Workbook_SheetChange event procedure , as well as a Worksheet_Change procedure , for your first question it will be easier if you can upload your workbook with some sample data in it.

Narayan
 
Hi Narayank991

Thanks for answers to question 2. It worked!

For Question 1, I have named the sheet that track changes "Logdetails"
It has 4 columns as per the current code below.
Value = Target.Value will show me the new value.

I was wondering if I can just add a new line to the code such as below to get the "Change from" old value

Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 1).Value = ?????????



Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If ActiveSheet.Name <> "LogDetails" Then
Application.EnableEvents = False
Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = ActiveSheet.Name & "-" & Target.Address(0, 0)
Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 1).Value = Target.Value
Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 2).Value = Environ("username")
Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 3).Value = Now
Sheets("LogDetails").Columns("A:D").AutoFit
Application.EnableEvents = True
End If
End Sub
 
Hi ,

You have 2 event procedures ; one where the earlier value is being stored in the variable sOld , and the other where the changed value is being written to the log file.

Depending on how the variable sOld has been defined , it might be available to the Workbook_SheetChange event procedure.

If it is , then all that is required is a line such as shown added to your existing code :
Code:
If ActiveSheet.Name <> "LogDetails" Then
  Application.EnableEvents = False
  With Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp)
        .Offset(1, 0).Value = ActiveSheet.Name & "-" & Target.Address(0, 0)
        .Offset(0, 1).Value = Target.Value
        .Offset(0, 2).Value = Environ("username")
        .Offset(0, 3).Value = Now
        .Offset(0, 4).Value = sOld
  End With
  Sheets("LogDetails").Columns("A:E").AutoFit
  Application.EnableEvents = True
End If
Narayan
 
Hi Narayan,

Thanks,

In the Macro, I only had the below. I don't know if sOld has been defined.
How can I write a definition? If you have to change the whole code, it is fine.

I am just adding an attachment so that it might be easier for you to teach me.

Intention.

In Raw data sheet, to highlight cell that has been changed.
to add a comment to the cell the changes made such as who, when, change from what to what.

Then in a separate log sheet, to summarize the change.
-Which cell has been changed. ( If instead of just cell H1 has been changed, the actual name of the cell can be shown, better. eg, Customer A )
-Old Value( it could be a number, it could be a text)
-New Value
-Who changed it
-When it was changed.

Thanks so much for taking you time.
 

Attachments

  • Book2.xlsm
    16.4 KB · Views: 34
Hi I have uploaded the workbook with some simple data and started to read VBA for dummies but still no answer yet, Anyone can help me?

VBA is fun though and great to learn
 
Hi ,

I am sorry , but your question is now a mini-project ! I am not in a position to devote the time required to implement all that you want done , at least at present.

Hopefully , someone else will step in and help you out.

Narayan
 
Dear Narayan

NO problem.
I tried using your suggestion but still only I get only new value in log sheet. I will try to study by myself. Thanks!!!

If ActiveSheet.Name <> "LogDetails"Then
Application.EnableEvents = False
With Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp)
.Offset(1, 0).Value = ActiveSheet.Name & "-" & Target.Address(0, 0)
.Offset(0, 1).Value = Target.Value
.Offset(0, 2).Value = Environ("username")
.Offset(0, 3).Value = Now
.Offset(0, 4).Value = sOld
EndWith
Sheets("LogDetails").Columns("A:E").AutoFit
Application.EnableEvents = True
EndIf
 
Hi this page will help that includes track changes to a separate sheet, one to txt file and one to csv file.

http://www.spreadsheetcreative.com/track-changes-log-csv-txt-excel-sheet/

The code to track changes to a csv log as follows, the txt and sheet codes and downloads found at the website

Cheers
Mitch

Code:
'// Track Changes log to CSV File
'Spreadsheet Creative, Mitch Rixon
'02/06/2016
'this creates a CSV file to the workbook directory if not already created
'each column displays Date and Time, User Name, Sheet Name, Cell Address, Old Value, New Value
'PASTE IN 'THIS WORKBOOK' MODULE


Option Explicit
Dim PreviousValue

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim sLogFileName As String, nFileNum As Long, sLogMessage As String
Dim NewValue As String
Dim xWorkbookName As String
xWorkbookName = Left(ThisWorkbook.Name, (InStrRev(ThisWorkbook.Name, ".", -1, vbTextCompare) - 1))

sLogFileName = ThisWorkbook.Path & "\" & xWorkbookName & " - track changes log.csv"
On Error GoTo exitsub
NewValue = Target.Value

On Error Resume Next ' Turn on error handling
  If Target.Value <> PreviousValue Then
 
  If Err.Number = 13 Then
  PreviousValue = 0
  End If
 
  On Error GoTo 0
 
  'On Error GoTo exitsub
  If IsEmpty(Target(1)) Then
  NewValue = "[empty cell]"
  End If
  sLogMessage = Format(Now, "dd/mm/yyyy") & ", " & Format(Now, "hh:mm") & ", " & Application.UserName & ", " & Target.Parent.Name & ", " & Target.Address _
  & ", " & PreviousValue & ", " & NewValue

  nFileNum = FreeFile  ' next file number
  Open sLogFileName For Append As #nFileNum  ' create the file if it doesn't exist
  Print #nFileNum, sLogMessage  ' append information
  Close #nFileNum  ' close the file
  End If
exitsub:
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
 
PreviousValue = Target(1).Value
  If IsEmpty(Target(1)) Then
  PreviousValue = "[empty cell]"
  End If
End Sub
 
Back
Top