PDA

View Full Version : Solved: Track Cell Value Change



hobbiton73
10-22-2012, 10:48 AM
Hi, I wonder whether someone may be able to help me please.

I'm using the code below to track and highlight changes within my workbook, changing the cell fill colour with an additional comment to show the previous value and who and when the change was made.

Option Explicit
Public preValue As Variant
Private Sub Worksheet_Change(ByVal Target As Range)

Dim Cell As Range
On Error Resume Next
For Each Cell In Target
If Not Intersect(Cell, Range("B5:Q2000")) Is Nothing Then
If Cell <> "" Then
Application.EnableEvents = False

With Range("A5:A" & Cell.Row)
.Value = Date

End With

With Range("AE5:AE" & Cell.Row)
.Value = "No"

End With

Application.EnableEvents = True

End If
End If
Next Cell
On Error GoTo 0

If Target.Count > 1 Then Exit Sub
Target.ClearComments
Target.AddComment.Text Text:="Previous Value was " & preValue & Chr(10) & "Revised " & Format(Date, "dd-mm-yyyy") & Chr(10) & "By " & Environ("UserName")
Target.Interior.ColorIndex = 35

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
preValue = Target.Value
End Sub

This works to some extent, but I have a few problems which I can't seem to solve.

I'm trying to set a range to be more precise B5:Q2000, whereby any changes made to the cells within that range will show the aforementioned cell colour change and comment. Despite, with my limited knowledge, incorporating this range within the code, all cells in and out of the range show the changes that have been made.

The second issue I have, is that I would only like the tracking to occur if the value of the cell is changed , rather than the current functionality which shows a cell change even if the user has just double clicked within the cell.

I've been working on these issues for quite some time now, and spent hours trying to find solutions.

I just wondered whether someone could perhaps have a look at these please and offer a little guidance on how I may go about resolving these problems.

Many thanks and the kindest regards

p45cal
10-23-2012, 04:03 AM
try:If Target.Cells.Count > 1 Then Exit Sub
On Error Resume Next
If Not Intersect(Target, Range("B5:Q2000")) Is Nothing Then
If Target.Value <> preValue And Target <> "" Then
Application.EnableEvents = False
Range("A5:A" & Target.Row).Value = Date
Range("AE5:AE" & Target.Row).Value = "No"
Application.EnableEvents = True
Target.ClearComments
Target.AddComment.text text:="Previous Value was " & preValue & Chr(10) & "Revised " & Format(Date, "dd-mm-yyyy") & Chr(10) & "By " & Environ("UserName")
Target.Interior.ColorIndex = 35
End If
End If
On Error GoTo 0
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count = 1 Then preValue = Target.Value
End Sub

hobbiton73
10-23-2012, 08:17 AM
Hi @p45cal, thank you so much for taking the time, again to reply to my post.

The solution is absolutely fantastic!

Thank you once again, and kind regards

hobbiton73
10-28-2012, 06:30 AM
Hi, I wonder whether someone may be able to help me please.

I'm using the code below to track Excel sheet changes, automatically adding a date and the word 'No' once data has been added to any row in the range B5:Q2000.


Option Explicit
Public preValue As Variant
Private Sub Worksheet_Change(ByVal Target As Range)

Dim Cell As Range, res As Variant
If Target.Cells.Count > 1 Then Exit Sub
On Error Resume Next
If Not Intersect(Target, Range("B5:Q2000")) Is Nothing Then
If Target.Value <> preValue And Target.Value <> "" Then
Application.EnableEvents = False
Range("A5:A" & Cell.Row).Value = Date
Range("AE5:AE" & Cell.Row).Value = "No"
Application.EnableEvents = True
Target.ClearComments
' Target.AddComment.Text Text:="Previous Value was " & preValue & Chr(10) & "Revised " & Format(Date, "dd-mm-yyyy") & Chr(10) & "By " & Environ("UserName")
Target.Interior.ColorIndex = 35
End If
End If
On Error GoTo 0

If Not Intersect(Target, Range("I5:I2000")) Is Nothing Then
Set Cell = Worksheets("Lists").Range("B2:C23")
res = Application.VLookup(Target, Cell, 2, False)
If IsError(res) Then
Range("J" & Target.Row).Value = ""
Else
Range("J" & Target.Row).Value = res
End If
End If

If Target.Column = 8 Then
If Target.Value = "E" Or Target.Value = "P" Then
Target.Offset(, 1).Value = "Enter_Project_or_Enhancement_Code"
Target.Offset(, 2).Value = "Enter_Description"
Else
Target.Offset(, 1).Value = ""
Target.Offset(, 2).Value = ""
End If
End If

If Target.Column = 8 Then
If Target.Value = "OH" Then
Target.Offset(, 3).Value = "N/A"
Else
Target.Offset(, 3).Value = ""
End If
End If

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count = 1 Then preValue = Target.Value
End Sub


The problem I'm encountering is as follows:

If the user inserts data into cells D5 and D10, the date and the word 'No' are added to the correct columns (A and AE) for these two rows.

However, unfortunately, the 'No' value and the date are also added to the these columns for the rows in between i.e D6-D9, even though the user hasn't entered any other data on these rows, and I'm not sure where the problem lies.

I just wondered whether someone may be able to take a look at this and offer some guidance on how I may go about solving this.

Many thanks and kind regards

p45cal
10-28-2012, 08:30 AM
The problem lies here:
Range("A5:A" & Cell.Row).Value = Date
Range("AE5:AE" & Cell.Row).Value = "No"
which should become:
Range("A" & Cell.Row).Value = Date
Range("AE" & Cell.Row).Value = "No"

hobbiton73
10-28-2012, 08:49 AM
Hi @p45cal, thank you very much for this, again!

I tweaked it a little changing 'cell.row' to 'Target.row' and it works great.

Thank you very much for all your time, trouble and patience.

Kind regards