powerpivot beginner
Member
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
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