macro to capture who accessed the Excel file

[cedmunds]

Anyone know of a way to capture who (user name, machine name etc.) had the excel file open when a certain cell is selected? a Macro?

Trying to use an Excel spreadsheet for a peer review where each reviewer accesses the Excel peer reivew file and enters the minutes they spent in the peer review but would like to also capture the user that had the file open when the minutes spent on the peer review were entered. This would provide proof that the actual peer reviewer opened the file and entered their minutes.

 

[pat_gilly]

after much searching I found this.I hope Vog who helped me earlier can do so again or whoever has the answer.

I want to track more than one column like column a1:a10, d1:d10, h1:h10
and log those changes .Can't figure out how to add more than one column range to Vog's code

 

[Kenneth Hobson]

Union.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim NR As Long
    If Intersect(Target, Union(Range("A1:A10"), Range("D1:D10"), Range("F15:F25"), Range("H1:H10"))) Is Nothing Then Exit Sub
    With Sheets("Log")
        .Unprotect Password:="xyz"
        NR = .Range("A" & Rows.Count).End(xlUp).Row + 1
        .Range("A" & NR).Value = Target.Address(False, False)
        .Range("B" & NR).Value = Now
        .Range("C" & NR).Value = Environ("username")
        .Protect Password:="xyz"
    End With
End Sub

 

[pat_gilly]

Just what I was looking for,Thank you Kenneth. Just one tweak please.Just like changes in colmn A are logged in A,B,C, how can I add Column D logged in D,E,F and col F in G,H,I. so that all logged data is in one row.

 

[Kenneth Hobson]

I would not recommend this method since it won't be database-like. In this example that does what I think you want, I also added some other tweaks such as doing it for each changed cell even if many are changed at once.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim NR As Long, tc As Integer, rTC As Range
    Dim cell As Range, rLogCells As Range
    
    Set rLogCells = Intersect(Target, Union(Range("A1:A10"), Range("D1:D10"), Range("H1:H10")))
    If rLogCells Is Nothing Then Exit Sub
    
    On Error GoTo EndNow
    'Speed routines, 'http://vbaexpress.com/kb/getarticle.php?kb_id=1035
    SpeedOn
    With Sheets("Log")
        .Unprotect Password:="xyz"
        
        For Each cell In rLogCells
            tc = cell.Column
            NR = .Cells(Rows.Count, tc).End(xlUp).Row + 1
            Set rTC = .Cells(NR, tc)
            rTC.Value = cell.Address(False, False)
            rTC.Offset(0, 1).Value = Now
            rTC.Offset(0, 2).Value = Environ("username")
            'rTC.Offset(0, 3).Value = cell.Value
            'rTC.Offset(0, 3).NumberFormat = cell.NumberFormat
        Next cell
        
        .UsedRange.EntireColumn.AutoFit
        .Protect Password:="xyz"
    End With
EndNow:
    SpeedOff
End Sub

The method that I prefer is to send the log data to an MDB table. At vbaexpress I attached examples for the Open and Close events using this method. The same method is easily done for the Change event.

 

[pat_gilly]

Hi Kenneth, I will habe no more than 100 changes a month and then a new workbook is created, for now I'll use the excel log method.But appreciate giving that link,I would have never guessed a mdb log was possible.

This #14 code is unfortunately not working.The log sheet is all blank.

 

[Kenneth Hobson]

Did you right click the sheet's tab to log, View Code, and then paste this code?

 

[sudburymetoo]

Is it possible to capture the value a user deleted, I mean if user deletes a cell or row,log shows cell value as blank,can you capture the deleted value ?

 

[pat_gilly]

I'm so sorry Kenneth,yes it works, silly me i put it in workbook.

 

[Kenneth Hobson]

TO save the value, uncomment the lines that I commented for the Value.

 

[sudburymetoo]

Did uncomment,it works,it captures the current value. It does not capture what was deleted. A1 has ' Apples', Its changed to 'oranges'. The log captures 'oranges'. Iwas thinking, can it capture oranges and in next cell give Apples.