Macro to extract and retain last users

Iron_Man

New Member
Joined
Aug 26, 2014
Messages
23
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:

Code:
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
 

Some videos you may like

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.

Comfy

Well-known Member
Joined
Dec 21, 2009
Messages
3,379
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

New Member
Joined
Aug 26, 2014
Messages
23
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

Well-known Member
Joined
Dec 21, 2009
Messages
3,379
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

New Member
Joined
Aug 26, 2014
Messages
23

ADVERTISEMENT

Great, thank you :)

It will be stored on sheet3 named "Index".
 

mikerickson

MrExcel MVP
Joined
Jan 15, 2007
Messages
23,901
You could use something like this in the ThisWorkbook code module
Code:
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

New Member
Joined
Aug 26, 2014
Messages
23

ADVERTISEMENT

You could use something like this in the ThisWorkbook code module
Code:
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 :)
 

Iron_Man

New Member
Joined
Aug 26, 2014
Messages
23
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

Well-known Member
Joined
Dec 21, 2009
Messages
3,379
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:
Code:
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:
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:
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:
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,122,217
Messages
5,594,887
Members
413,947
Latest member
gizmolucy

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top