Logging user access to Spreadsheets

[DPChristman]

I have seen different versions of this question and suggestions going back a number of years, but nothing recent.

I have a spreadsheet (report log) that is used by everyone in my department.

The problem occurs when one user tries to access the spreadsheet, only to get the message that the spreadsheet is opened by 'another user'.

This is particularly problematic at the beginning of a new fiscal year, because the users are constantly updating the spreadsheet with new reports.

I would like to maintain an automatic user log to keep track of who was in last.

This would make it easier to drop a direct (let me know when you are done) email to that person.

Is there a way to do this?

 

[mole999]

If the software is installed per user rather than corporate, it tends to say whos in the file

 

[AkaTrouble]

i would create a log sheet

and in this workbook module

Private Sub Workbook_Open()


Dim name As String
name = Application.UserName
  
   Dim LastRow As Long, ws As Worksheet

    Set ws = Sheets("Log")

    LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row + 1 'Finds the last blank row

    ws.Range("A" & LastRow).Value = name
    ws.Range("B" & LastRow).Value = Now
    

   
   

End Sub

this will put user name in column A and date and time in column B of a sheet called log (sheet name can be anything you like just change code)

edit one line not needed

 

[DPChristman]

This did not work. What step am I missing?

 

[AkaTrouble]

the code has to go in Thisworkbook

then file saved as xlsm macro enabled then on opening the workbook it should add entry to bottom of sheet called "Log"

sheet has to already be there

 

[DPChristman]

Thanks, I actually just figured out the Thisworkbook part.

It is working now.

Is there a way to keep the log updated if the last user did not save before they exited?

Often the problem is that the last person to open the file, left it opened and did not save anything.

 

[AkaTrouble]

just add one line

Private Sub Workbook_Open()

Dim name As String
name = Application.UserName
Dim LastRow As Long, ws As Worksheet

    Set ws = Sheets("Log")

    LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row + 1 'Finds the last blank row

    ws.Range("A" & LastRow).Value = name
    ws.Range("B" & LastRow).Value = Now

[COLOR=#ff0000]ActiveWorkbook.Save[/COLOR]

End Sub

 

[DPChristman]

Nice. Thanks!