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

 

[Iron_Man]

Comfy,

This is absolutely amazing. Exactly what I needed and with instructions that even someone who doesn't know anything about VBA (like me) can follow.

I can't thank you enough!

IM

 

[Comfy]

Comfy,

This is absolutely amazing. Exactly what I needed and with instructions that even someone who doesn't know anything about VBA (like me) can follow.

I can't thank you enough!

IM

I'm glad it works.

But it's by no means a finished article though due to the lack of error checking. Also, another Boardie or MVP can probably suggest a better way.

 

[Iron_Man]

Hi Comfy,

I should have tested everything first... I have just sent the file to one of my coworkers to see if their user ID would show up as well. Unfortunately, my username was replaced by my coworker's on the first line. Can you think of a reason why this has happened?

The only thing I amended in your code was the line and cells number to actually move it to a new format, apart from that everything is stock standard.

 

[Comfy]

I don't know enough about how Environ() works so can only suggest things from other posts.

Try post number 3 here: http://www.mrexcel.com/forum/excel-questions/2252-get-windows-user-name.html

In your standard module delete everything and re-paste this:

Option Explicit
Declare Function Get_User_Name Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, _
nSize As Long) As Long
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
Function GetUserName() As String
Dim lpBuff As String * 25


Get_User_Name lpBuff, 25
GetUserName = Left(lpBuff, InStr(lpBuff, Chr(0)) - 1)
End Function

In the ThisWorkbook module delete everything and re-paste this:

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("Log").Cells(i, 15).Value = Sheets("Log").Cells(i - 1, 15).Value
Sheets("Log").Cells(i, 16).Value = Sheets("Log").Cells(i - 1, 16).Value
Next i
Sheets("Log").Cells(12, 15).Value = GetUserName()
Sheets("Log").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

Test it and let me know.

 

[Iron_Man]

Comfy, thanks for this. I'll only be able to test it tomorrow with another work user so I'll let you know after that.

Regardless, thanks for your persistence!

IM

 

[Comfy]

Comfy, thanks for this. I'll only be able to test it tomorrow with another work user so I'll let you know after that.

Regardless, thanks for your persistence!

IM

You're more than welcome.

What version of excel are you using and what version of windows?

 

[Iron_Man]

Hi Comfy,

Unfortunately the new code has the same effect. It captures the current user and overwrites what is entered on the first line (I changed your code so for me it is in cells T3 (username) and T4 (date time) as opposed to adding to the next line.

If you have an easy fix I'll definitely implement it, otherwise I'll work with this and just keep track of the last user. Also I use Windows 7 and Excel 2007.

Thanks again.

IM

 

[Comfy]

Unfortunately the new code has the same effect. It captures the current user and overwrites what is entered on the first line (I changed your code so for me it is in cells T3 (username) and T4 (date time) as opposed to adding to the next line.

I'm confused, I thought you wanted to track the last 10 users and the times starting in O12 and P12.

The macro starts in O21 and P21 and copies the values from the row above. It does this for O13:P13, it then enters the current user and time in O12 and P12. Is this not what you wanted?

As you're using windows 7 try this for retrieving the username: excel vba - UserName = Environ$("UserName") not working in latest versions of Windows? - Stack Overflow

CreateObject("WScript.Network").Username

I'm currently at work and using XP so can't test.

 

[Iron_Man]

Haha, this is obviously when having English as a second language becomes interesting...

What I was hoping to achieve and failed to explain was to have from T3 to U13 (I changed the setup of the page but thought I'd be able to adjust your code) the last 10 users. Whether it starts from the bottom to the top or the other way doesn't really matter. Except that I now understand that your code works one way (bottom up).

What would be your recommendation to limit the number of cells which capture the last users to 10? I can't rely on the other users to manually erase past entries of username but I don't want the file to keep picking up everything.

Thanks,

IM

 

[Comfy]

What would be your recommendation to limit the number of cells which capture the last users to 10? I can't rely on the other users to manually erase past entries of username but I don't want the file to keep picking up everything.

Just do as I have done and limit it to a range of cells, Currently O12:P21.

This can be changed to T3:U13 by updating the following lines.

For i = 21 To 13 Step -1
Sheets("Log").Cells(i, 15).Value = Sheets("Log").Cells(i - 1, 15).Value
Sheets("Log").Cells(i, 16).Value = Sheets("Log").Cells(i - 1, 16).Value
Next i
Sheets("Log").Cells(12, 15).Value = GetUserName()
Sheets("Log").Cells(12, 16).Value = Now()
End If

To

For i = 12 To 4 Step -1
Sheets("Log").Cells(i, 20).Value = Sheets("Log").Cells(i - 1, 20).Value
Sheets("Log").Cells(i, 21).Value = Sheets("Log").Cells(i - 1, 21).Value
Next i
Sheets("Log").Cells(3, 20).Value = GetUserName()
Sheets("Log").Cells(3, 21).Value = Now()
End If