Macro to extract and retain last users

[Iron_Man]

Hi guys,

I have a workbook in which I'd like to keep track of the last 10 users who modified my workbook.

I currently have the following code to extract the current user but cannot figure out how to modify it to achieve what I want:

Private Sub Workbook_Open()
sheet3.Range("O12").Value = Environ("username")
End Sub

Ideally, I'd like to have in O12 the username of the last user who modified the workbook and in P12 the date and time at which the change was made (or the file was closed, providing a change was made).
Then, in O13, the second last username, etc.

And ideally, have a macro linked to a button where I can erase the whole list of 10 and obviously enter my username back at the top of the list with the appropriate date.

Am I being completely unrealistic or can this be done?

Thanks in advance to whoever can help me

IM

 

[Comfy]

It can be done but will need a little more info.

"last user who modified the workbook"

Would this be just who clicked Save last?
Or is this everytime a User changes a value in a cell.

Also, is this just for one sheet or all sheets in the workbook.

 

[Iron_Man]

I should have probably clarified all that...

I'm not interested in keeping track of who has looked at the file, only made changes (anywhere in the workbook). Realistically though, I assume the only way to capture this will be to have the macro run and write the username every time the user makes a change, so if more than 10 changes are made, the whole list will be filled with their name...

Do you have any suggestion Comfy?

 

[Comfy]

Do you have any suggestion Comfy?

I might, just testing something.

I'm thinking that if a change is made we just write that username when the workbook is saved.

But where will this log be kept? In a worksheet called log?

 

[Iron_Man]

Great, thank you

It will be stored on sheet3 named "Index".

 

[mikerickson]

You could use something like this in the ThisWorkbook code module

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    With Me.Sheets("MyHiddenSheet").Cells(Rows.Count, 1).End(xlUp)
        If .Cells(1, 1) <> Environ("username") And Int(Val(CStr(.Cells(1, 2).Value))) <> Int(Date) Then
            Application.EnableEvents = False
            .Cells(2, 1).Value = Environ("username")
            .Cells(2, 2).Value = Now
            Application.EnableEvents = True
        End If
    End With
End Sub

 

[Iron_Man]

You could use something like this in the ThisWorkbook code module

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    With Me.Sheets("MyHiddenSheet").Cells(Rows.Count, 1).End(xlUp)
        If .Cells(1, 1) <> Environ("username") And Int(Val(CStr(.Cells(1, 2).Value))) <> Int(Date) Then
            Application.EnableEvents = False
            .Cells(2, 1).Value = Environ("username")
            .Cells(2, 2).Value = Now
            Application.EnableEvents = True
        End If
    End With
End Sub

Thanks mikerickson but unfortunately I got nothing. I replaced MyHiddentSheet with Index but nothing happens. I'll wait until Comfy comes up with something clever and I'll keep trying on my side

 

[mikerickson]

Actualy that test should be OR rather than AND

 

[Iron_Man]

Hi mikerickson,

Unfortunately the macro didn't do anything, I kept monitoring my "Index" sheet after changing your test to and OR but to no avail.

I'm still open to any suggestion you guys may have

Thanks for the help guys.

IM

 

[Comfy]

Right, so I have something that works but might need some changes and there maybe a better war to achieve this.

Open your VBA editor and place this code in each sheet that you wish to track changes:

Option Explicit
Public RunEvents As Boolean
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call UpdateCellDetails
End Sub

Next, in the VBA editor double click the "ThisWorkbook" object and enter this code:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim i As Long
If RunEvents Then
For i = 21 To 13 Step -1
Sheets("Index").Cells(i, 15).Value = Sheets("Index").Cells(i - 1, 15).Value
Sheets("Index").Cells(i, 16).Value = Sheets("Index").Cells(i - 1, 16).Value
Next i
Sheets("Index").Cells(12, 15).Value = Environ("username")
Sheets("Index").Cells(12, 16).Value = Now()
End If
End Sub
Private Sub Workbook_Open()
Me.ActiveSheet.Cells(1, 1).Select
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Sh.Cells(1, 1).Select
End Sub

Next, insert a standard module and enter this code:

Option Explicit
Public CellBefore As New cCellDetails
Public RunEvents As Boolean
Sub UpdateCellDetails()
Static pPrevious As Range
Dim CellAfter As New cCellDetails


If CellBefore.Address = "" Then
Cells(1, 1).Select
CellBefore.Text = ActiveCell.Text
CellBefore.Formula = ActiveCell.Formula
CellBefore.Address = ActiveCell.Address
Else
CellAfter.Text = Range(CellBefore.Address).Text
CellAfter.Formula = Range(CellBefore.Address).Formula
CellAfter.Address = Range(CellBefore.Address).Address




Set pPrevious = ActiveCell




If Not CellAfter Is Nothing Then
If CellBefore.Text <> CellAfter.Text Or CellBefore.Formula <> CellAfter.Formula Then RunEvents = True
End If


CellBefore.Text = pPrevious.Text
CellBefore.Formula = pPrevious.Formula
CellBefore.Address = pPrevious.Address
End If
End Sub

Finally, insert a Class Module and rename it to cCellDetails, then enter this code:

Private pText As String
Private pFormula As String
Private pAddress As String
Public Property Get Text() As String
Text = pText
End Property
Public Property Let Text(Value As String)
pText = Value
End Property
Public Property Get Formula() As String
Formula = pFormula
End Property
Public Property Let Formula(Value As String)
pFormula = Value
End Property
Public Property Get Address() As String
Address = pAddress
End Property
Public Property Let Address(Value As String)
pAddress = Value
End Property

Make sure your sheet called "Index" exists I have not added any checks for this yet.


This will do the following:

Track of a cell value or cell formula is changed.
If it is it will added the time and username to your index sheet when the workbook is saved.