Recording Time of Changes in another Worksheet

[michaelb_]

MAJOR AMATURE ALERT! I'm trying to code a module to record the time of changes made to a workbook (several worksheets) to another worksheet. I can get the code to record the time of the change for a range with multiple columns to the next cell over (xOffsetColumn = 1). I am trying to send that to another worksheet though and also format the data in a column. I have not yet spent time trying to format to a column, I have just been trying to send the data to another sheet.

This is my code so far:

Private Sub Workbook_SheetChange(ByVal ws As Object, ByVal Target As Range)'Record time of changes made to worksheet
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ActiveWorkbook
Set ws = Sheets("Sheet1")
wb.Activate
ws.Select
Dim WorkRng As Range
Dim xOffsetColumn As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("A:E"), Target)
xOffsetColumn = Worksheets("REVISION HISTORY").Range("A1")
If Not WorkRng Is Nothing Then
    Application.EnableEvents = False
    For Each Rng In WorkRng
        If Not VBA.IsEmpty(Rng.Value) Then
            Rng.Offset(0, xOffsetColumn).Value = Now
            Rng.Offset(0, xOffsetColumn).NumberFormat = "dd-mm-yyyy, hh:mm:ss"
        End If
    Next
    Application.EnableEvents = True
End If
End Sub

 

[Yongle]

1 which columns are you trying to monitor in each sheet?
- do you want to record any change or changes in specific columns (or cells etc)
- are those columns the same for every sheet
- which sheets are being monitored

2 what do you want recorded in sheet "Revision History"?
- the sheet name
- cell reference
- new value
- date and time of change
- user name

 

[michaelb_]

1) I am trying to monitor columns A through E on every sheet. I imagine that I can just have a separate module for each sheet though.

 

[michaelb_]

I'm going to post my current code to the OP.

 

[Logit]

.
You can compare your project to this one and hopefully see what edits are required ... or simply use this project and
avoid re-creating the wheel ?

This project requires a sheet named TRACKER. The sheet can be hidden if you like.

Paste this into the THISWORKBOOK module :

Option Explicit


Dim vOldVal 'Must be at top of module


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)


Dim bBold As Boolean




If Target.Cells.Count > 1 Then Exit Sub


'On Error Resume Next


    With Application
         .ScreenUpdating = False
         .EnableEvents = False


    End With


    If IsEmpty(vOldVal) Then vOldVal = "Empty Cell"
    bBold = Target.HasFormula
        With Sheets("Tracker")
            '.Unprotect Password:="Secret"
                If .Range("A1") = vbNullString Then
                    .Range("A1:F1") = Array("Cell Changed", "Old Value", _
                        "New Value", "Time of Change", "Date of Change", "User")
                End If


            With .Cells(.Rows.Count, 1).End(xlUp)(2, 1)
                  .Value = ActiveSheet.Name & " : " & Target.Address
                  .Offset(0, 1) = vOldVal
            With .Offset(0, 2)
              If bBold = True Then
                .ClearComments
                .AddComment.Text Text:= _
                     "OzGrid.com:" & Chr(10) & "" & Chr(10) & _
                        "Bold values are the results of formulas"


              End If
                .Value = Target
                .Font.Bold = bBold
                
            End With
                .Offset(0, 3) = Time
                .Offset(0, 4) = Date
                .Offset(0, 5) = Application.UserName
            End With
            .Cells.Columns.AutoFit
            '.Protect Password:="Secret"
        End With


    vOldVal = vbNullString


    With Application
         .ScreenUpdating = True
         .EnableEvents = True
    End With
On Error GoTo 0
End Sub




Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    vOldVal = Target
End Sub


Private Sub test()
    Application.EnableEvents = True
End Sub

 

[michaelb_]

My current code is just trying to record the time of any change made in columns A through E in the first available cell in column F. Eventually I want to record more than just the time, hopefully the location of the change in the workbook too. Also, I eventually want to record the change in the first available cell in column A in a 'revision history' sheet.

Here's the code.

Private Sub Worksheet_Change(ByVal Target As Range)'Record time of changes made to worksheet
Dim WorkRng As Range
Dim Rng As Range
Dim LastRowF As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("A:E"), Target)
LastRowF = ActiveSheet.Range("F:F").End(xlUp).Offset(1).Row
If Not WorkRng Is Nothing Then
    Application.EnableEvents = False
    For Each Rng In WorkRng
        If Not VBA.IsEmpty(WorkRng.Value) Then
[B]            Rng.LastRowF[/B].Value = Now
            [B]Rng.LastRowF[/B].Value.NumberFormat = "dd-mm-yyyy, hh:mm:ss"
        End If
    Next
    Application.EnableEvents = True
End If
End Sub

I'm not sure how to refer to putting the value extracted in the last row in column F.

 

[michaelb_]

Awesome, that worked; thanks!

 

[Logit]

You are welcome.