This is a universal log system, that a few people here and myself have created. I\'m rather proud of it... I am running into two issues... if someone can help with the sollution
Matt
Few Things
On Error Resume Next
is not proper handling. It should be avoided unless and until it is absolutely necessary.Worksheet_Change
event, it is better to switch off events and then turn them back on at the end to avoid possible endless loop.PreviousValue
so I am assuming that you do not want the code to run when the user selects multiple cells?I think this is what you are trying (UNTESTED)?
Option Explicit
Dim PreviousValue
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sLogFileName As String, nFileNum As Long, sLogMessage As String
Dim NewVal
On Error GoTo Whoa
Application.EnableEvents = False
sLogFileName = ThisWorkbook.Path & Application.PathSeparator & "Log.txt"
If Not Target.Cells.Count > 1 Then
If Target.Value <> PreviousValue Then
If Len(Trim(Target.Value)) = 0 Then _
NewVal = "Blank" Else NewVal = Target.Value
sLogMessage = Now & Application.UserName & _
" changed cell " & Target.Address & " from " & _
PreviousValue & " to " & NewVal
nFileNum = FreeFile
Open sLogFileName For Append As #nFileNum
Print #nFileNum, sLogMessage
Close #nFileNum
End If
End If
LetsContinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume LetsContinue
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
PreviousValue = Target(1).Value
End Sub
This worked for me. Ideally you'd have a named range on the sheet being tracked which you could use to restrict tracking only to changes occuring inside that range.
Const MAX_TRACKED_CELLS As Long = 50
Dim PreviousValues As Object
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
Dim haveDict As Boolean, val, addr
haveDict = Not PreviousValues Is Nothing
If Target.Cells.Count <= MAX_TRACKED_CELLS Then
For Each c In Target.Cells
addr = c.Address()
If haveDict Then
If PreviousValues.exists(addr) Then
val = PreviousValues(addr)
End If
Else
val = "{unknown}"
End If
If c.Value <> val Then
Debug.Print "Changed:", addr, IIf(val = "", "Empty", val), _
" to ", IIf(c.Value = "", "Empty", c.Value)
End If
Next c
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim c As Range
If PreviousValues Is Nothing Then
Set PreviousValues = CreateObject("scripting.dictionary")
Else
PreviousValues.RemoveAll
End If
If Target.Cells.Count <= MAX_TRACKED_CELLS Then
For Each c In Target.Cells
PreviousValues.Add c.Address(), c.Value
Next c
End If
End Sub