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]

I think you might see better results from the copying to Sheet2 and saving from there but if you truly want to save this in a separate file you can try this however note that if you give the file to someone you need to make sure they have access to where it will save these changes.

Create a file on your desktop and alter this line throughout

Workbooks.Open "C:\Users\UserName\Desktop\Change Log.xlsx", ReadOnly:=False

In the workbooks code

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim wb as Workbook
Closedby = Application.UserName
DateClosed = Now()
Application.DisplayAlerts = False
Workbooks.Open "C:\Users\UserName\Desktop\Change Log.xlsx", ReadOnly:=False
Set wb = ActiveWorkbook
cpyrng4 = wb.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row + 1
wb.Sheets("Sheet1").Range("A" & cpyrng4).Value = "Closed File"
wb.Sheets("Sheet1").Range("B" & cpyrng4).Value = Closedby
wb.Sheets("Sheet1").Range("C" & cpyrng4).Value = DateClosed
wb.Save
wb.Close
Application.DisplayAlerts = True
Set wb = Nothing
End Sub


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim wb as Workbook
Saveby = Application.UserName
DateSave = Now()
Application.DisplayAlerts = False
Workbooks.Open "C:\Users\UserName\Desktop\Change Log.xlsx", ReadOnly:=False
Set wb = ActiveWorkbook
cpyrng3 = wb.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row + 1
wb.Sheets("Sheet1").Range("A" & cpyrng3).Value = "Save File"
wb.Sheets("Sheet1").Range("B" & cpyrng3).Value = Saveby
wb.Sheets("Sheet1").Range("C" & cpyrng3).Value = DateSave
wb.Save
wb.Close
Application.DisplayAlerts = True
Set wb = Nothing
End Sub


Private Sub Workbook_Open()
Dim wb as Workbook
Openby = Application.UserName
DateOpen = Now()
Application.DisplayAlerts = False
Workbooks.Open "C:\Users\UserName\Desktop\Change Log.xlsx", ReadOnly:=False
Set wb = ActiveWorkbook
cpyrng2 = wb.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row + 1
wb.Sheets("Sheet1").Range("A" & cpyrng2).Value = "Open File"
wb.Sheets("Sheet1").Range("B" & cpyrng2).Value = Openby
wb.Sheets("Sheet1").Range("C" & cpyrng2).Value = DateOpen
wb.Save
wb.Close
Application.DisplayAlerts = True
Set wb = Nothing


End Sub

In the worksheet Sheet1

Public Oval As String


Private Sub Worksheet_Change(ByVal Target As Range)
Dim wb As Workbook
Changedby = Application.UserName
DateChanged = Now()
Application.DisplayAlerts = False
Workbooks.Open "C:\Users\UserName\Desktop\Change Log.xlsx", ReadOnly:=False
Set wb = ActiveWorkbook
cpyrng = wb.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row + 1
wb.Sheets("Sheet1").Range("A" & cpyrng).Value = "Change Value"
wb.Sheets("Sheet1").Range("B" & cpyrng).Value = Changedby
wb.Sheets("Sheet1").Range("C" & cpyrng).Value = DateChanged
wb.Sheets("Sheet1").Range("D" & cpyrng).Value = Target.Address
wb.Sheets("Sheet1").Range("E" & cpyrng).Value = Target.Value
wb.Sheets("Sheet1").Range("F" & cpyrng).Value = Oval
wb.Save
wb.Close
Application.DisplayAlerts = True
Set wb = Nothing
End Sub


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

 

[bearcub]

Thank you again. The file I'm creating is for our staff so I wanted to provide them with options as to how they want to see the log data. Just thinking outside the box.
I think this will do splendidly. I think they will be happy with what you've provided me.

One more thing though, is it possible to create a text file on the fly (if it doesn't exist in the same directory as the file then create one then append all the data to this closed text file) in the same directory as the file?

Right now you have the text file saved to a static location before the code is run but my file might be going to several people who don't really understand Excel.

They can push the buttons but they would be lost if they had to inside the code and change the location of the saved text file or manually create a text file.

If we can get Excel to create a text file in the same path as the file automatically that would prevent a lot of confusion on their part. I'm dealing with HR admins who aren't too savvy in Excel.

Sorry to be a pest and nuance about this. I can just hear them asking me for this type of automation.

Michael

 

[Coding4Fun]

Code in the Worksheet Sheet1

Public Oval As String


Private Sub Worksheet_Change(ByVal Target As Range)
Dim wb As Workbook
Changedby = Application.UserName
DateChanged = Now()
Application.DisplayAlerts = False
mypath = ActiveWorkbook.FullName
mypath2 = Left(ActiveWorkbook.FullName, Len(ActiveWorkbook.FullName) - Len(ActiveWorkbook.Name))
On Error GoTo CantOpen:
Workbooks.Open mypath2 & "Change Log.xlsx", ReadOnly:=False
Set wb = ActiveWorkbook
cpyrng = wb.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row + 1
wb.Sheets("Sheet1").Range("A" & cpyrng).Value = "Change Value"
wb.Sheets("Sheet1").Range("B" & cpyrng).Value = Changedby
wb.Sheets("Sheet1").Range("C" & cpyrng).Value = DateChanged
wb.Sheets("Sheet1").Range("D" & cpyrng).Value = Target.Address
wb.Sheets("Sheet1").Range("E" & cpyrng).Value = Target.Value
wb.Sheets("Sheet1").Range("F" & cpyrng).Value = Oval
wb.Save
wb.Close
Application.DisplayAlerts = True
Set wb = Nothing


Exit Sub
CantOpen:
    Workbooks.Add
    ActiveWorkbook.SaveAs mypath2 & "Change Log.xlsx", FileFormat:=51
    Resume Next


End Sub


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

Code in the Workbook

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Closedby = Application.UserName
DateClosed = Now()
Application.DisplayAlerts = False
mypath = ActiveWorkbook.FullName
mypath2 = Left(ActiveWorkbook.FullName, Len(ActiveWorkbook.FullName) - Len(ActiveWorkbook.Name))
On Error GoTo CantOpen:
Workbooks.Open mypath2 & "Change Log.xlsx", ReadOnly:=False
Set wb = ActiveWorkbook
cpyrng4 = wb.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row + 1
wb.Sheets("Sheet1").Range("A" & cpyrng4).Value = "Closed File"
wb.Sheets("Sheet1").Range("B" & cpyrng4).Value = Closedby
wb.Sheets("Sheet1").Range("C" & cpyrng4).Value = DateClosed
wb.Save
wb.Close
Application.DisplayAlerts = True
Set wb = Nothing


Exit Sub


CantOpen:
    Workbooks.Add
    ActiveWorkbook.SaveAs mypath2 & "Change Log.xlsx", FileFormat:=51
    Resume Next


End Sub


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Saveby = Application.UserName
DateSave = Now()
Application.DisplayAlerts = False
mypath = ActiveWorkbook.FullName
mypath2 = Left(ActiveWorkbook.FullName, Len(ActiveWorkbook.FullName) - Len(ActiveWorkbook.Name))
On Error GoTo CantOpen:
Workbooks.Open mypath2 & "Change Log.xlsx", ReadOnly:=False
Set wb = ActiveWorkbook
cpyrng3 = wb.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row + 1
wb.Sheets("Sheet1").Range("A" & cpyrng3).Value = "Save File"
wb.Sheets("Sheet1").Range("B" & cpyrng3).Value = Saveby
wb.Sheets("Sheet1").Range("C" & cpyrng3).Value = DateSave
wb.Save
wb.Close
Application.DisplayAlerts = True
Set wb = Nothing


Exit Sub
CantOpen:
    Workbooks.Add
    ActiveWorkbook.SaveAs mypath2 & "Change Log.xlsx", FileFormat:=51
    Resume Next


End Sub


Private Sub Workbook_Open()


Openby = Application.UserName
DateOpen = Now()
Application.DisplayAlerts = False
mypath = ActiveWorkbook.FullName
mypath2 = Left(ActiveWorkbook.FullName, Len(ActiveWorkbook.FullName) - Len(ActiveWorkbook.Name))
On Error GoTo CantOpen:
Workbooks.Open mypath2 & "Change Log.xlsx", ReadOnly:=False
Set wb = ActiveWorkbook
cpyrng2 = wb.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row + 1
wb.Sheets("Sheet1").Range("A" & cpyrng2).Value = "Open File"
wb.Sheets("Sheet1").Range("B" & cpyrng2).Value = Openby
wb.Sheets("Sheet1").Range("C" & cpyrng2).Value = DateOpen
wb.Save
wb.Close
Application.DisplayAlerts = True
Set wb = Nothing




Exit Sub
CantOpen:
    Workbooks.Add
    ActiveWorkbook.SaveAs mypath2 & "Change Log.xlsx", FileFormat:=51
    Resume Next




End Sub