|
Got any Excel Questions? Excel Help
Track/Report User Changes on an Excel Worksheet/Workbook
As some Excel users are aware, Excel has a feature called Track
Changes, found under Tools on the Worksheet Menu Bar.
However, when this is chosen you are forced to share the Workbook. With
this feature enabled, there are many standard Excel features that are no
longer available. See "Features that are unavailable in shared
workbooks" in the Excel help for details.
To overcome this issue we can employ some help from Excel VBA and makes use of Excel's Change Events. Just be aware this code is only designed to track and record user changes to one cell at a time. Also, the code 'as is' assumes you have a Worksheet in the Workbook with a Sheet CodeName of Sheet1. This Worksheet should also be xlVeryHidden so other users are not able to modify the report. While there is Worksheet protection applied to Sheet1, Excel's Worksheet protection is rather weak so the hiding of the sheet is an added measure. Especially when we lock the Visual Basic Editor .
Track/Report User Changes on 1 Particular Worksheet.
The code below must be placed in the Private Module of the Worksheet you would like changes tracked and logged. To easily get there right click on the sheet name tab and choose View Code. In here paste the code below;
Dim vOldVal 'Must be at top of module Private Sub Worksheet_Change(ByVal Target As Range) Dim bBold As Boolean If Target.Cells.Count > 1 Then Exit Sub On Error Resume Next With Application .ScreenUpdating = False .EnableEvents = False End With If IsEmpty(vOldVal) Then vOldVal = "Empty Cell" bBold = Target.HasFormula With Sheet1 .Unprotect Password:="Secret" If .Range("A1") = vbNullString Then .Range("A1:E1") = Array("CELL CHANGED", "OLD VALUE", _ "NEW VALUE", "TIME OF CHANGE", "DATE OF CHANGE") End If With .Cells(.Rows.Count, 1).End(xlUp)(2, 1) .Value = Target.Address .Offset(0, 1) = vOldVal With .Offset(0, 2) If bBold = True Then .ClearComments .AddComment.Text Text:= _ "OzGrid.com:" & Chr(10) & "" & Chr(10) & _ "Bold values are the results of formulas" End If .Value = Target .Font.Bold = bBold End With .Offset(0, 3) = Time .Offset(0, 4) = Date End With .Cells.Columns.AutoFit .Protect Password:="Secret" End With vOldVal = vbNullString With Application .ScreenUpdating = True .EnableEvents = True End With On Error GoTo 0 End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) vOldVal = Target End SubTrack/Report User Changes on all Worksheets in 1 Workbook
The code below must be placed in the Private Module of the Workbook (ThisWorkbook) you would like changes tracked and logged. To easily get there right click on the excel icon, top left next to File and choose View Code. In here paste the code below;
Dim vOldVal 'Must be at top of module Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim bBold As Boolean If Target.Cells.Count > 1 Then Exit Sub On Error Resume Next With Application .ScreenUpdating = False .EnableEvents = False End With If IsEmpty(vOldVal) Then vOldVal = "Empty Cell" bBold = Target.HasFormula With Sheet1 .Unprotect Password:="Secret" If .Range("A1") = vbNullString Then .Range("A1:E1") = Array("CELL CHANGED", "OLD VALUE", _ "NEW VALUE", "TIME OF CHANGE", "DATE OF CHANGE") End If With .Cells(.Rows.Count, 1).End(xlUp)(2, 1) .Value = Target.Address .Offset(0, 1) = vOldVal With .Offset(0, 2) If bBold = True Then .ClearComments .AddComment.Text Text:= _ "OzGrid.com:" & Chr(10) & "" & Chr(10) & _ "Bold values are the results of formulas" End If .Value = Target .Font.Bold = bBold End With .Offset(0, 3) = Time .Offset(0, 4) = Date End With .Cells.Columns.AutoFit .Protect Password:="Secret" End With vOldVal = vbNullString With Application .ScreenUpdating = True .EnableEvents = True End With On Error GoTo 0 End Sub Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) vOldVal = Target End Sub
Excel Dashboard Reports & Excel Dashboard Charts 50% Off Become an ExcelUser Affiliate & Earn Money
Special! Free Choice of Complete Excel Training Course OR Excel Add-ins Collection on all purchases totaling over $64.00. ALL purchases totaling over $150.00 gets you BOTH! Purchases MUST be made via this site. Send payment proof to [email protected] 31 days after purchase date.
Instant Download and Money Back Guarantee on Most Software
Excel Trader Package Technical Analysis in Excel With $139.00 of FREE software!
Microsoft � and Microsoft Excel � are registered trademarks of Microsoft Corporation. OzGrid is in no way associated with Microsoft
Some of our more popular products are below...
Convert Excel Spreadsheets To Webpages | Trading In Excel | Construction Estimators | Finance Templates & Add-ins Bundle | Code-VBA | Smart-VBA | Print-VBA | Excel Data Manipulation & Analysis | Convert MS Office Applications To...... | Analyzer Excel | Downloader Excel
| MSSQL Migration
Toolkit |
Monte Carlo Add-in |
Excel
Costing Templates