It will be a lot more user friendly if the users only needs to enter their details on opening the workbook.
Further it is quite easy to do, but there is some work involved in order to make it reasonable fool proof.
In essence:
If a user does not enable the macros, then the workbook should be locked for writing, with a message mentioning this
Each worksheet will need to contain the macro in its module.
A hidden empty template sheet with the macro is required, in case a user adds a new sheet
Weakness:
A savvy excel user can always break the system
A user can enter anyone's name in the entry box
If more users use only one PC then you are stuck with asking each time, although this could be improved by not asking when the changes are done within say a minute of each other.
Or the users need to close Excel when they are finished.
Improvements:
If the users all use their own PC, then the user initials can be extracted from Excel, or from Windows.
OK here goes:
- Add a new sheet to the workbook
- Name it 'UserLog'
- add the following in the sheet
4. You need to add some named ranges:
A5: Log
E3: CurrentUser
G3: DateTime
5. Add a new sheet to the workbook
6. Name it 'Warning'
7. Add some text to it with appropriate font size and colours to tell the user that macro's need to be enabled in order to make changes
8. Add a new sheet to the workbook
9. Name it 'NewShtTemplate'
10. Right click on the name tab and select 'View Code'
11. Paste the following code in the VBA window that has opened.
VBA Code:
Option Explicit
Const iDelay As Integer = 1 '<<< Delay in minutes before name is asked again
Dim vPreviousVal As Variant
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Store current value of cell, any time a cell gets selected
If Target.Cells.Count = 1 Then
vPreviousVal = Target.Value
Else
vPreviousVal = "Unknown" ' Multiple cells selected
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
'Store changes to a log sheet. _
>> There has to be a worksheet with the name 'UserLog' (the log sheet may be hidden) _
>> In this sheet UserLog cell E3 is named 'CurrentUser', _
>> and cell E5 is named 'DateTime'. _
>> Also a few rows down the log starts, with the top left cell _
>> of the header named 'Log'. _
>> The log is 7 columns wide with headings: _
>> First Last Sheet Cell address Previous New Date Time
Dim sN As String
Dim vL(1 To 7) As Variant, vU(1 To 3) As Variant
'The additional row to the log is built up i an array vL
vL(1) = Sheets("UserLog").Range("CurrentUser")
vL(2) = Sheets("UserLog").Range("CurrentUser").Offset(0, 1)
If Now() > Sheets("UserLog").Range("DateTime") + iDelay / (24 * 60) Then
GetName:
sN = InputBox("Enter First/Last name (separated by / (slash))", _
Title:="User name", Default:=vL(1) & "/" & vL(2))
If Len(sN) And sN Like "*/*" Then
vL(1) = Split(sN, "/")(0)
vL(2) = Split(sN, "/")(1)
' The changes to username and date stamp are built up in array vU
vU(1) = vL(1)
vU(2) = vL(2)
vU(3) = Now()
'write vU to the log sheet
Sheets("UserLog").Range("CurrentUser").Resize(1, 3).Value = vU
Else
GoTo GetName
End If
Else
vU(3) = Now()
End If
'add change to log
vL(3) = Me.Name
vL(4) = Target.Address
vL(5) = vPreviousVal
vL(6) = Target.Value
vL(7) = vU(3)
vU(3) = vL(7)
'write vL to the log sheet
With Sheets("UserLog").Range("Log").CurrentRegion
.Offset(.Rows.Count, 0).Resize(1, 7).Value = vL
End With
End Sub
12. While you are in the VBA editor, in the left top window, you will see the list of sheets in the workbook and 'ThisWorkbook'
Double click on ThisWorkbook to open the workbook module.
Now paste the following code in the window.
VBA Code:
Option Explicit
Const sWBPW As String = "MyPW" '<<<< modify to suit. Record it somewhere safe!!!
Dim wsActive As Worksheet
Private Sub Workbook_NewSheet(ByVal Sh As Object)
' When the user adds a new sheet, this macro copies
' the hidden sheet 'NewShtTemplate'. This template sheet can
' contain event macros, so that the new sheet also
' has these events.
Dim shT As Worksheet
Dim sN As String
'make copy of hidden template
Application.ScreenUpdating = False
With Sheets("NewShtTemplate")
.Visible = xlSheetVisible
.Copy after:=Sh
Set shT = ActiveSheet
.Visible = xlSheetHidden
End With
'get the name of the user created sheet and delete the sheet
sN = Sh.Name
Application.DisplayAlerts = False
Sh.Delete
Application.DisplayAlerts = True
' rename the copied template sheet with the new sheet name
shT.Name = sN
Application.ScreenUpdating = True
End Sub
Private Sub Workbook_Open()
'run macro to hide warning sheet and unlock sheets
Dim bB As Boolean
Workbook_AfterSave b
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'run macro to show warning sheet and lock sheets
Dim shSh As Worksheet
'store current sheet
Set wsActive = ActiveSheet
For Each shSh In Me.Sheets
If shSh.ProtectContents = False Then
shSh.Protect sWBPW
End If
Next shSh
With Sheets("Warning")
.Visible = xlSheetVisible
.Activate
End With
End Sub
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
'run macro to hide warning sheet and unlock sheets
Dim shSh As Worksheet
Const sDontUnprotect As String = "Sheet1;Warning" '<<< List sheets not to be unprotected separated by ;
For Each shSh In Me.Sheets
If Not "*;" & shSh.Name & ";*" Like sDontUnprotect Then
shSh.Unprotect sWBPW
End If
Next shSh
Sheets("Warning").Visible = xlSheetHidden
'restore current sheet
If Not wsActive Is Nothing Then wsActive.Activate
End Sub
