User Open close and Save Changes log sheet

[bearcub]

I would like to create a sheet in an Excel workbook that would log everyone who was opened the file, the time and date and changes were made and the time and date the file was closed.

This file is going to be sent out to our reps and we would like to have an ongoing log which will document when the file was opened, record the time when any changes were made (saved or cells were updated/changed) and when the file was closed.

I know that when you share a file you have this feature but we don't want to go that route.

Is this possible?

Thank you for your help

Michael

 

[Coding4Fun]

Create a new workbook.
Add a Sheet2
Right Click Sheet1 and add click View Code
On the left panel double click on the Workbook and insert the following code

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Closedby = Application.UserName
DateClosed = Now()


cpyrng4 = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row + 1
Sheets("Sheet2").Range("A" & cpyrng4).Value = "Closed File"
Sheets("Sheet2").Range("B" & cpyrng4).Value = Closedby
Sheets("Sheet2").Range("C" & cpyrng4).Value = DateClosed
End Sub


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Saveby = Application.UserName
DateSave = Now()


cpyrng3 = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row + 1
Sheets("Sheet2").Range("A" & cpyrng3).Value = "Save File"
Sheets("Sheet2").Range("B" & cpyrng3).Value = Saveby
Sheets("Sheet2").Range("C" & cpyrng3).Value = DateSave


End Sub


Private Sub Workbook_Open()


Openby = Application.UserName
DateOpen = Now()


cpyrng2 = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row + 1
Sheets("Sheet2").Range("A" & cpyrng2).Value = "Open File"
Sheets("Sheet2").Range("B" & cpyrng2).Value = Openby
Sheets("Sheet2").Range("C" & cpyrng2).Value = DateOpen


End Sub

Then you are going to go back into the code for Sheet1 in the panel on the left in the VB code window double Click on Sheet1 and insert this code

Private Sub Worksheet_Change(ByVal Target As Range)
Changedby = Application.UserName
cpyrng = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row + 1
Sheets("Sheet2").Range("A" & cpyrng).Value = "Change Value"
Sheets("Sheet2").Range("A" & cpyrng).Value = Changedby
Sheets("Sheet2").Range("B" & cpyrng).Value = Target.Address
Sheets("Sheet2").Range("C" & cpyrng).Value = Target.Value


End Sub

This this in place any time something is changed on sheet one it will log it in sheet 2.
Test, tweak, enjoy

Let me know if you still need assistance.

 

[Coding4Fun]

It looks like if you actually change this piece in the Worksheet code it will also capture the Old value as well as what it was changed to. I also made it so it will capture the date and time the change is made.

[COLOR=#ff0000]Public Oval As String[/COLOR]


Private Sub Worksheet_Change(ByVal Target As Range)
Changedby = Application.UserName
[COLOR=#ff0000]DateChanged = Now()[/COLOR]
cpyrng = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row + 1
Sheets("Sheet2").Range("A" & cpyrng).Value = "Change Value"
Sheets("Sheet2").Range("A" & cpyrng).Value = Changedby
[COLOR=#ff0000]Sheets("Sheet2").Range("B" & cpyrng).Value = DateChanged[/COLOR]
Sheets("Sheet2").Range("C" & cpyrng).Value = Target.Address
Sheets("Sheet2").Range("D" & cpyrng).Value = Target.Value
[COLOR=#ff0000]Sheets("Sheet2").Range("E" & cpyrng).Value = Oval[/COLOR]


End Sub
[COLOR=#ff0000]
[/COLOR]
[COLOR=#ff0000]Private Sub Worksheet_SelectionChange(ByVal Target As Range)[/COLOR]
[COLOR=#ff0000]On Error Resume Next[/COLOR]
[COLOR=#ff0000]Oval = Target.Value[/COLOR]
End Sub

 

[Coding4Fun]

Sorry had a typo in the previous post

Public Oval As String

Private Sub Worksheet_Change(ByVal Target As Range)
Changedby = Application.UserName
DateChanged = Now()
cpyrng = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row + 1
Sheets("Sheet2").Range("A" & cpyrng).Value = "Change Value"
Sheets("Sheet2").Range("[COLOR=#ff0000]B[/COLOR]" & cpyrng).Value = Changedby
Sheets("Sheet2").Range("[COLOR=#ff0000]C[/COLOR]" & cpyrng).Value = DateChanged
Sheets("Sheet2").Range("[COLOR=#ff0000]D[/COLOR]" & cpyrng).Value = Target.Address
Sheets("Sheet2").Range("[COLOR=#ff0000]E[/COLOR]" & cpyrng).Value = Target.Value
Sheets("Sheet2").Range("[COLOR=#ff0000]F[/COLOR]" & cpyrng).Value = Oval


End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
Oval = Target.Value
End Sub

On another note I realized it might be good to save these changes and not rely on the user but that can be tricky if the user changes something this will not ask them if they want to save in the case they want to "Undo"

Private Sub [COLOR=#ff0000]Workbook_BeforeClose[/COLOR](Cancel As Boolean)
Closedby = Application.UserName
DateClosed = Now()


cpyrng4 = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row + 1
Sheets("Sheet2").Range("A" & cpyrng4).Value = "Closed File"
Sheets("Sheet2").Range("B" & cpyrng4).Value = Closedby
Sheets("Sheet2").Range("C" & cpyrng4).Value = DateClosed
[COLOR=#ff0000]ThisWorkbook.Save[/COLOR]
End Sub

 

[Coding4Fun]

Haha wish I could edit longer than 10 mins later

That comment regarding saving might be a null factor as you would only want to save the log if the user is actually saving their changes and once something is changed Excel will naturally prompt the user to save.

The method I provided is more of a force save before close.

 

[bearcub]

Thank you, it looks like this will work.

Can you send me a clean copy of what it should be - you've made a number of alterations and I would like to know which one would actually do the trick. Looks like I can edit as necessary, thank you for the help.

 

[Coding4Fun]

Sorry yeah I was quick to post and had alot of after thoughts on this one

In the workbook code

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Closedby = Application.UserName
DateClosed = Now()

cpyrng4 = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row + 1
Sheets("Sheet2").Range("A" & cpyrng4).Value = "Closed File"
Sheets("Sheet2").Range("B" & cpyrng4).Value = Closedby
Sheets("Sheet2").Range("C" & cpyrng4).Value = DateClosed
ThisWorkbook.Save
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Saveby = Application.UserName
DateSave = Now()

cpyrng3 = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row + 1
Sheets("Sheet2").Range("A" & cpyrng3).Value = "Save File"
Sheets("Sheet2").Range("B" & cpyrng3).Value = Saveby
Sheets("Sheet2").Range("C" & cpyrng3).Value = DateSave

End Sub



Private Sub Workbook_Open()

Openby = Application.UserName
DateOpen = Now()

cpyrng2 = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row + 1
Sheets("Sheet2").Range("A" & cpyrng2).Value = "Open File"
Sheets("Sheet2").Range("B" & cpyrng2).Value = Openby
Sheets("Sheet2").Range("C" & cpyrng2).Value = DateOpen


End Sub

In the worksheet "Sheet1" code

Public Oval As String


Private Sub Worksheet_Change(ByVal Target As Range)
Changedby = Application.UserName
DateChanged = Now()
cpyrng = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row + 1
Sheets("Sheet2").Range("A" & cpyrng).Value = "Change Value"
Sheets("Sheet2").Range("B" & cpyrng).Value = Changedby
Sheets("Sheet2").Range("C" & cpyrng).Value = DateChanged
Sheets("Sheet2").Range("D" & cpyrng).Value = Target.Address
Sheets("Sheet2").Range("E" & cpyrng).Value = Target.Value
Sheets("Sheet2").Range("F" & cpyrng).Value = Oval




End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
Oval = Target.Value
End Sub

 

[bearcub]

Works Great! thank you for this.

If I wanted to hide sheet2 when it opened (having it really hidden from view) or I wanted to close sheet2 after viewing it (I wanted to the ability to hide or view it manually at will), how would I do this?

Or, if I wanted to save this to a text file, would this be possible?

Thank you again for you help. You saved me!

Michael

 

[Coding4Fun]

Glad I could help

If I wanted to hide sheet2 when it opened (having it really hidden from view) or I wanted to close sheet2 after viewing it (I wanted to the ability to hide or view it manually at will), how would I do this?

You could adjust the Workbook_Open event, which would hide Sheet2 when the workbook is opened. Then you can just right click Sheet1 and choose Unhide and unhide Sheet2 manually. When you save and close it, the next time it is open it will hide Sheet2 so you only need to manually unhide it but do not need to rehide it.

Private Sub Workbook_Open()


Openby = Application.UserName
DateOpen = Now()


cpyrng2 = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row + 1
Sheets("Sheet2").Range("A" & cpyrng2).Value = "Open File"
Sheets("Sheet2").Range("B" & cpyrng2).Value = Openby
Sheets("Sheet2").Range("C" & cpyrng2).Value = DateOpen


[COLOR=#ff0000]Sheets("Sheet2").Visible = False[/COLOR]


End Sub

Or, if I wanted to save this to a text file, would this be possible?

To the comment about saving it as a text file you can do this too. I would recommend saving it in excel as a separate workbook but if you actually need it in a .txt format you can do this.

Note the code below will save 4 different versions, choose the one you want and remove the others.

Sub copychanges()


Sheets("Sheet2").Visible = True
Sheets("Sheet2").Copy


ActiveWorkbook.SaveAs Filename:="C:\Users\UserName\Desktop\MyFile.txt", FileFormat:=xlTextWindows
ActiveWorkbook.SaveAs Filename:="C:\Users\UserName\Desktop\MyFile.xls", FileFormat:=56
ActiveWorkbook.SaveAs Filename:="C:\Users\UserName\Desktop\MyFile.xlsx", FileFormat:=51
ActiveWorkbook.SaveAs Filename:="C:\Users\UserName\Desktop\MyFile.xlsm", FileFormat:=52


End Sub

 

[bearcub]

Great, thank you.

What I meant by saving it to a text file I meant instead of saving it as a new sheet you would save all the changes to text file as opposed to Sheet 2. Can this be done?

Thank you for all your help.

Michael