PDA

View Full Version : Tracking Changes to a worksheet using VBA



gztimmy
10-19-2016, 01:07 PM
So I wanted a way to track changes by a user to an excel worksheet. I didn't like the automated way that excel does it and searched and found a vba code on this site.

Option Explicit
Public preValue As Variant
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
Target.ClearComments
Target.AddComment.Text Text:="Previous Value was " & preValue & Chr(10) & "Revised " & Format(Date, "mm-dd-yyyy") & Chr(10) & "By " & Environ("UserName")
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target = "" Then
preValue = "a blank"
Else: preValue = Target.Value
End If
End Sub


My issue is I would like the comments to stay and not be overwritten so it tracks all changes. I tried removing the "target.clearcomments" line but it gave me debug error. I'm also not very good at VBA so any help you guys could give me would be greatly appreciated.

gztimmy
10-22-2016, 08:59 AM
Ok I found a code on another site but now it wont insert the comments unless I manually go to the cell and insert a comment that way. Any ideas?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim tempvalue As Variant
Dim T, ChrCount, trimval1, trimval2 As Long
Dim oComment As Comment

Set oComment = Target.Comment
If Not oComment Is Nothing Then
tempvalue = oComment.Text
For T = 1 To Len(tempvalue)
If Mid(tempvalue, T, 1) = Chr(10) Then
ChrCount = ChrCount + 1
If ChrCount = 1 Then trimval1 = T
If ChrCount = 2 Then trimval2 = T
End If
Next T
If ChrCount >= 5 Then
tempvalue = Right(tempvalue, Len(tempvalue) - trimval2) & Chr(10) & preValue
Else
tempvalue = Right(tempvalue, Len(tempvalue) - trimval1) & Chr(10) & preValue
End If

Target.ClearComments
Target.AddComment.Text Text:="Previous Values are (Earliest to latest) " & Chr(10) & tempvalue & " By " & Environ("UserName")
Target.Comment.Shape.Height = 100
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target = "" Then
preValue = "a blank"
Else: preValue = Target.Value
End If
End Sub

SamT
10-22-2016, 10:29 AM
Here's a sippet from MyPersonal.xls

Function Comment_Text_Returning(Me_Range As Range) As String
Dim MyText As String
MyText = Me_Range.Comment.Shape.TextFrame.Characters.Text


'Usage:
' Dim SomeText As String
' SomeText = Comment_Text_Returning(Range("A1"))
' MsgBox (SomeText)tring


End Function

In your sub, first set MyText

MyText = Target.Comment.Shape.TextFrame.Characters.Text

Then create a variable with the new comment String, Then

Target.AddComment MyText & VBCrLf & VBCrLf & NewText