Public RAGenabled As Boolean
Dim OldVal As String
Private Const lDelim As String = "("
Private Const rDelim As String = ")"
Private Sub cbRAGenabled_Click()
' A checkbox on the worksheet that controls whether the auditing is done or not
RAGenabled = cbRAGenabled.Value
If RAGenabled = True Then
MsgBox "RAG checking enabled"
Else
MsgBox "RAG checking disabled"
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'
' Determines whether the range (cell) that was changes is one I want to audit (and only if auditing is ON)
'
If RAGenabled = True Then 'Only bother if RAG checking is toggled ON
Application.EnableEvents = False ' prevent recursive worksheet_change events
If Not (Application.Intersect(Target, Range("MyRange")) Is Nothing) Then ' Process if selection is in MyRange range
Call AuditTheChange(ByVal Target)
End If
' If selection is not in MyRange ranges, ignore it
Application.EnableEvents = True ' re-enable events
End If
'
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
'
RAGenabled = cbRAGenabled.Value 'ensure current value, esp. first time through
If RAGenabled = True Then 'Only check if RAG checking is toggled ON
If (Application.Intersect(Target, Range("MyRange")) Is Nothing) Then ' is it in MyRange?
'MsgBox "Selected cell is not within an appropriate range" ' For debugging purposes only
Exit Sub 'if it's not in a range to be audited, do nowt
Else 'it is, so ...
If Target.Count = 1 Then ' is only one cell selected?
OldVal = Target.Value
'MsgBox "OldVal='" & OldVal & "'" ' For debugging purposes only
Else
MsgBox "Multiple selections can't be processed - select one cell at a time"
End If
End If
End If
'
End Sub
'The cell value is stored in a public variable when a cell is selected (Worksheet_SelectionChange procedure).
'Then, when a new value is added, the Worksheet_Change event procedure adds a cell comment
'(the error generated if the cell already has a comment is stepped over) and then uses the stored variable
'as part of the text string for the comment, building up a change history over time.
'Adapted from http://www.j-walk.com/ss/excel/eee/eee014.txt
Sub AuditTheChange(ByVal Target As Range)
'
If Target.Count = 1 Then ' check is only one cell selected?
' record a change in a comment box
On Error Resume Next ' Ignore the error if you have previously ....
Target.AddComment ' added comment box
Target.Comment.Text Target.Comment.Text & "Whatever you want the audit text to be"
Target.Interior.Pattern = xlSolid
With Target.Font
.Name = "Arial"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
OldVal = Target.Value ' reset OldVal in case the selection is not changed before the cell value is changed again
End If
End Sub