Matt Ridge
Matt Ridge

Reputation: 3651

I have a code to log usage in an excel sheet, but I get one bug, and one issue

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 it be great.

Here is the code:

Option Explicit
Dim PreviousValue

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim sLogFileName As String, nFileNum As Long, sLogMessage As String

    sLogFileName = ThisWorkbook.path & Application.PathSeparator & "Log.txt"

 On Error Resume Next ' Turn on error handling
    If Target.Value <> PreviousValue Then
        ' Check if we have an error
        If Err.Number = 13 Then
           PreviousValue = 0
        End If
        ' Turn off error handling
        On Error GoTo 0
        sLogMessage = Now & Application.UserName & " changed cell " & Target.Address _
        & " from " & PreviousValue & " to " & Target.Value

        nFileNum = FreeFile                         ' next file number
        Open sLogFileName For Append As #nFileNum   ' create the file if it doesn't exist
        Print #nFileNum, sLogMessage                ' append information
        Close #nFileNum                             ' close the file
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    PreviousValue = Target(1).Value
End Sub

Here are the two issues.

  1. If more than once cell is selected, and attempted to be written to, the script errors out.
  2. If someone edits a cell and leaves it blank, it will show 8/30/2012 1:45:01 PM Matthew Ridge changed cell $K$3 from Test to instead of 8/30/2012 1:45:01 PM Matthew Ridge changed cell $K$3 from Test to Blank or Empty

Upvotes: 1

Views: 223

Answers (2)

Tim Williams
Tim Williams

Reputation: 166391

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

Upvotes: 1

Siddharth Rout
Siddharth Rout

Reputation: 149305

Matt

Few Things

  1. On Error Resume Next is not proper handling. It should be avoided unless and until it is absolutely necessary.
  2. When you are working with Worksheet_Change event, it is better to switch off events and then turn them back on at the end to avoid possible endless loop.
  3. If you are switching events off then it is a must that you use proper error handling.
  4. Since you are storing the just a single cell in the 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

Upvotes: 3

Related Questions