PDA

View Full Version : Solved: Show previous value in a insert comment



Shazam
07-10-2006, 07:10 AM
I would like to know if this is possible. Maybe could be done in a UDF.

If I change the value in cell A1 then the code will insert a comment in cell A1 displaying the previous value I changed. Can that be done any part of the workbook?

OBP
07-10-2006, 09:27 AM
This one is a bit tricky, first of all you have to use the Application event procedure, Sheetchange. The VBA to put the value in the cell's comment is simple enough -
ActiveCell.ClearComments
ActiveCell.AddComment "was " & Str(ActiveCell.Value)
The problem that you have is that the Sheetchange event only occurs AFTER you have made the change, so the value in the cell has already changed. About the only way that I could see it working would be to use a "mirror" worksheet that contains the current values in your working sheet. When the working sheet is changed the VBA looks up the old value from the the "mirror" sheet and puts that in the comment and then updates it with the new value.
Is it worth it one asks?
Of course you could use the macro above to put the cell value in the comment for you, before you change the value
Perhaps someone else with more advanced VBA tehcniques like Firefytr or mdmackillop can help you.

mdmackillop
07-10-2006, 09:48 AM
If you don't have too many cells to track, add the following to the worksheet module

Option Explicit
Dim Monitor(), MCells As Range, Chk As Long
Private Sub Worksheet_Activate()
Dim i As Long
Chk = 2
ReDim Monitor(1, Chk)
Monitor(0, 0) = "A1"
Monitor(0, 1) = "B16"
Monitor(0, 2) = "F9"
Set MCells = Range(Monitor(0, 0))
For i = 0 To Chk
Monitor(1, i) = Range(Monitor(0, i))
Set MCells = Union(MCells, Range(Monitor(0, i)))
Next
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
If Not Intersect(Target, MCells) Is Nothing Then
For i = 0 To Chk
If Monitor(0, i) = Target.Address(0, 0) Then
Target.Comment.Text Text:="was " & Monitor(1, i)
Monitor(1, i) = Target.Value
Exit Sub
End If
Next
End If
End Sub

Shazam
07-10-2006, 09:56 AM
Hi mdmackillop,

I'm getting a debugger on this line.


If Not Intersect(Target, MCells) Is Nothing Then


Any ideas why?


Also can the code work for all the cells in the worksheet.

mdmackillop
07-10-2006, 10:58 AM
What were you doing when the error occurred.
You can add as many cells to the code as you care to, and it should work.

OBP's worksheet solution is more complicated than it looks, but here's some code to try. I was attempting with the commented section, to delete code from the copied sheet, which would simplify things, but no success yet

Option Explicit
Dim ws As Worksheet, wsA As Worksheet
Private Sub Worksheet_Activate()
Dim ThisModule As Object
If Right(ActiveSheet.Name, 1) = "A" Then Exit Sub
Application.EnableEvents = False
Application.DisplayAlerts = False
Set ws = ActiveSheet
ActiveSheet.Copy After:=Sheets(Sheets.Count)
On Error Resume Next
Sheets(ws.Name & "A").Delete
ActiveSheet.Name = ws.Name & "A"
Set wsA = ActiveSheet
ws.Activate
'Set ThisModule = Application.VBE.ActiveVBProject.VBComponents
'With ThisModule(wsA.CodeName)
' .CodeModule.DeleteLines 1, .CodeModule.CountOfLines
'End With
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Right(ActiveSheet.Name, 1) = "A" Then Exit Sub
Dim tmp As String
If Target.Value <> Sheets(ActiveSheet.Name & "A").Range(Target.Address).Value Then
If Target.Comment Is Nothing Then Target.AddComment
Target.Comment.Text Text:="was " & wsA.Range(Target.Address).Value
If Target.Comment.Text = "was " Then Target.Comment.Text Text:="was blank"
wsA.Range(Target.Address) = Target.Value
End If
End Sub

johnske
07-10-2006, 10:58 AM
http://www.vbaexpress.com/kb/getarticle.php?kb_id=783

OBP
07-10-2006, 11:20 AM
Johnske, your KB entry proves my concept was correct, even if my VBA was not up to doing it from memory.
A petty that your version is not quite correct. You have not instructed the user to copy sheet 1 to sheet 2 first. If you do not do this you loose the initial value that is already in the cell. All subsequent changes work great.
I wold never have believed that the code could be so compact and powerful.

Shazam
07-10-2006, 03:46 PM
Hi mdmackillop,


Thanks for the reply. I'm still getting a debugger. All I did was changing
the value in the cell. So I did a quick print screen and paste it on to a word Doc to show you the error. Please look at the attachment below.

johnske
07-10-2006, 03:57 PM
Johnske, your KB entry proves my concept was correct, even if my VBA was not up to doing it from memory.
A petty that your version is not quite correct. You have not instructed the user to copy sheet 1 to sheet 2 first. If you do not do this you loose the initial value that is already in the cell. All subsequent changes work great.
I wold never have believed that the code could be so compact and powerful.Well, there's really no need for the other sheet, that was only an example, you could use a public variable...

Option Explicit
'
Dim PrevVal As String
'
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.Cells.Count > 1 Then Exit Sub
PrevVal = Target
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
'
On Error Resume Next
'//(can't overwrite an existing comment)\\
Target.ClearComments
With Target
.AddComment
.Comment.Visible = False
.Comment.Text Text:="Previous value = " & PrevVal
End With
'
End Sub

Shazam
07-10-2006, 03:58 PM
Well, there's really no need for the other sheet, that was only an example, you could use a public variable...

Option Explicit
'
Dim PrevVal As String
'
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
PrevVal = Target
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
'
On Error Resume Next
'//(can't overwrite an existing comment)\\
Target.ClearComments
With Target
.AddComment
.Comment.Visible = False
.Comment.Text Text:="Previous value = " & PrevVal
End With
'
End Sub



Hi johnske your code works great. Can it be modified only when there is a value in it. Because if i type in 300 in a blank cell a insert comment appears saying "Previous value = ". May I have it trigger only if there is a value already in place?

johnske
07-10-2006, 04:09 PM
Just use an If statement...

Dim PrevVal As String
'
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.Cells.Count > 1 Then Exit Sub
PrevVal = Target
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
'
On Error Resume Next
If PrevVal <> Empty Then
'//(can't overwrite an existing comment)\\
Target.ClearComments
With Target
.AddComment
.Comment.Visible = False
.Comment.Text Text:="Previous value = " & PrevVal
End With
End If
'
End Sub

Shazam
07-10-2006, 04:32 PM
Just use an If statement...

Dim PrevVal As String
'
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.Cells.Count > 1 Then Exit Sub
PrevVal = Target
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
'
On Error Resume Next
If PrevVal <> Empty Then
'//(can't overwrite an existing comment)\\
Target.ClearComments
With Target
.AddComment
.Comment.Visible = False
.Comment.Text Text:="Previous value = " & PrevVal
End With
End If
'
End Sub




It works very well johnske. Thank You so much.

One more thing. If I hit delete on one of the cells that has a value with a insert comment can the code delete the insert comment as well?

johnske
07-10-2006, 06:43 PM
...One more thing. If I hit delete on one of the cells that has a value with a insert comment can the code delete the insert comment as well?Nothing comes to mind... But someone else may have an idea for that.

PS: I just noticed in your original post you said "Can that be done any part of the workbook?" - Yes, put this variation in the 'ThisWorkbook' module...


Option Explicit
Public PrevVal As String

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Selection.Cells.Count > 1 Then Exit Sub
PrevVal = Target
End Sub


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'
On Error Resume Next
If PrevVal <> Empty Then
'//(can't overwrite an existing comment)\\
Target.ClearComments
With Target
.AddComment
.Comment.Visible = False
.Comment.Text Text:="Previous value = " & PrevVal
End With
End If
'
End Sub

Shazam
07-10-2006, 08:03 PM
Nothing comes to mind... But someone else may have an idea for that.



Hi johnske I think I got it. Did a bit of modifying and I think it works.



Dim PrevVal As String
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call SelectionEvent1(Target)
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Call ChangeEvent1(Target)
Call ChangeEvent2(Target)

End Sub
Private Sub SelectionEvent1(ByVal Target As Range)
If Selection.Cells.Count > 1 Then Exit Sub
PrevVal = Target
End Sub


Private Sub ChangeEvent1(ByVal Target As Range)
'
On Error Resume Next
If PrevVal <> Empty Then
'//(can't overwrite an existing comment)\\
Target.ClearComments
With Target
.AddComment
.Comment.Visible = False
.Comment.Text Text:="Previous value = " & PrevVal
End With
End If
'
End Sub
Private Sub ChangeEvent2(ByVal Target As Range)
Selection.ClearComments
End Sub

Shazam
07-11-2006, 11:49 AM
Thank You for all your help everyone!