Hi MrExcel Community,
It's my first post here - so "Hello"
Currently I'm using this Audit Trail Macro to track cell changes in multiple sheets:
As this macro only tracks the cell-reference, it becomes useless (for my need) as soon as the data in the sheets is sorted. So my question:
How can I additionally track the content of specific, corresponding cells, e.g. the ID in the first column and the column header in the first row?
For example:
<tbody>
</tbody>
<tbody>
</tbody>
So when I change value 1 in the 2nd row to "x" (in red), the tracker should store the ID "001" & the header "value 1".
Right now it stores this:
<tbody>
</tbody>
And I would need this:
<tbody>
</tbody>
Do you have any ideas how this could be accomplished? I'm thankful for every tipp I can get.
Richie
It's my first post here - so "Hello"
Currently I'm using this Audit Trail Macro to track cell changes in multiple sheets:
Code:
Option Explicit
Dim sOldAddress As String
Dim vOldValue As Variant
Dim sOldFormula As String
Private Sub Workbook_TrackChange(Cancel As Boolean)
Dim sh As Worksheet
For Each sh In ActiveWorkbook.Worksheets
sh.PageSetup.LeftFooter = "&06" & ActiveWorkbook.FullName & vbLf & "&A"
Next sh
End Sub
Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
'''''''''''''''''''''''''''''''''''''''''''''
'Thanks to lenze for getting me started on this project ([URL]http://vbaexpress.com/kb/getarticle.php?kb_id=909[/URL])
'http://www.mrexcel.com/forum/excel-questions/376400-vba-ignoring-exit-sub-select-all.html?referrerid=76744 'Thanks to Colin_L
'Adapted by Mark Reierson 2009
'''''''''''''''''''''''''''''''''''''''''''''
Dim wSheet As Worksheet
Dim wActSheet As Worksheet
Dim iCol As Integer
Set wActSheet = ActiveSheet
On Error Resume Next ' This Error-Resume-Next is only to allow the creation of the tracker sheet.
Set wSheet = Sheets("Tracker")
'**** Add the tracker Sheet if it does not exist ****
If wSheet Is Nothing Then
Set wActSheet = ActiveSheet
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Tracker"
End If
On Error GoTo 0
'**** End of specific error resume next
On Error GoTo ErrorHandler
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
With Sheets("Tracker")
'******** This bit of code moves the tracker over a column when the first columns are full**'
If .Cells(1, 1) = "" Then '
iCol = 1 '
Else '
iCol = .Cells(1, 256).End(xlToLeft).Column - 7 '
If Not .Cells(65536, iCol) = "" Then '
iCol = .Cells(1, 256).End(xlToLeft).Column + 1 '
End If '
End If '
'********* END *****************************************************************************'
.Unprotect Password:="xxxxx"
'******** Sets the Column Headers **********************************************************
If LenB(.Cells(1, iCol).Value) = 0 Then
.Range(.Cells(1, iCol), .Cells(1, iCol + 7)) = Array("Cell Changed", "Old Value", _
"New Value", "Old Formula", "New Formula", "Time of Change", "Date of Change", "User")
.Cells.Columns.AutoFit
End If
With .Cells(.Rows.Count, iCol).End(xlUp).Offset(1)
.Value = sOldAddress
.Offset(0, 1).Value = vOldValue
.Offset(0, 3).Value = sOldFormula
If Target.Count = 1 Then
.Offset(0, 2).Value = Target.Value
If Target.HasFormula Then .Offset(0, 4).Value = "'" & Target.Formula
End If
.Offset(0, 5) = Time
.Offset(0, 6) = Date
.Offset(0, 7) = Application.UserName
.Offset(0, 7).Borders(xlEdgeRight).LineStyle = xlContinuous
End With
.Protect Password:="xxxxx"
End With
ErrorExit:
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
wActSheet.Activate
Exit Sub
ErrorHandler:
'any error handling you want
'Debug.Print "We have an error"
Resume ErrorExit
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal sh As Object, ByVal Target As Range)
With Target
sOldAddress = .Address(external:=True)
If .Count > 1 Then
vOldValue = "Multiple Cell Select"
sOldFormula = vbNullString
Else
vOldValue = .Value
If .HasFormula Then
sOldFormula = "'" & Target.Formula
Else
sOldFormula = vbNullString
End If
End If
End With
End SubAs this macro only tracks the cell-reference, it becomes useless (for my need) as soon as the data in the sheets is sorted. So my question:
How can I additionally track the content of specific, corresponding cells, e.g. the ID in the first column and the column header in the first row?
For example:
| ID | value 1 | value 2 | value 3 | value 4 |
| 001 | 1 | 110 | cccd | |
| 002 | x | b | 2 | 29 |
<tbody>
</tbody>
| ID | value 1 | value 2 | value 3 | value 4 |
| 001 | x | 110 | cccd | |
| 002 | x | b | 2 | 29 |
<tbody>
</tbody>
So when I change value 1 in the 2nd row to "x" (in red), the tracker should store the ID "001" & the header "value 1".
Right now it stores this:
| Cell Changed | Old Value | New Value | Old Formula | New Formula | Time | Date | User |
| [Test.xlsm]Sheet1'!$I$11 | 1 | x | 10:00:01 | 24.11.2017 | Richie |
<tbody>
</tbody>
And I would need this:
| Cell Changed | ID | Column | Old Value | New Value | Old Formula | New Formula | Time | Date | User |
| [Test.xlsm]Sheet1'!$I$11 | 001 | value 1 | 1 | x | 10:00:01 | 24.11.2017 | Rich |
<tbody>
</tbody>
Do you have any ideas how this could be accomplished? I'm thankful for every tipp I can get.
Richie
