salahianoo
New Member
- Joined
- Feb 21, 2024
- Messages
- 4
- Office Version
- 365
- 2021
- Platform
- Windows
I have a workbook in read only mode and im the admin so the other users can edit in cells i decided only and when they save their changes they are saving it in new work book (system required unfortunately)
now i have to make audit trail on the basic work book
i used this code but it is not working in read only mode
please help me as u can
=================================
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
Application.EnableEvents = False
Dim ov As Variant, nv As Variant
nv = Target.Value
Application.Undo
ov = Target.Value
Target = nv
With Sheets("Log")
On Error GoTo HDL:
.Cells(Rows.Count, 1).End(xlUp)(2) = Environ("UserName")
.Cells(Rows.Count, 1).End(xlUp).Offset(, 1) = Target.Parent.Name
.Cells(Rows.Count, 1).End(xlUp).Offset(, 2) = Target.Address
If ov = "" Then
.Cells(Rows.Count, 1).End(xlUp).Offset(, 3) = "Blank"
Else
.Cells(Rows.Count, 1).End(xlUp).Offset(, 3) = ov
End If
If nv = "" Then
.Cells(Rows.Count, 1).End(xlUp).Offset(, 4) = "Blank"
Else
.Cells(Rows.Count, 1).End(xlUp).Offset(, 4) = nv
End If
.Cells(Rows.Count, 1).End(xlUp).Offset(, 5) = Now
If .Columns(6).ColumnWidth < 15 Then .Columns(6).ColumnWidth = 15
End With
HDL:
If Err.Number > 0 Then
MsgBox "The following error occurred:" & Err.Number & vbLf & Err.Description & "."
End If
Application.EnableEvents = True
End Sub
now i have to make audit trail on the basic work book
i used this code but it is not working in read only mode
please help me as u can
=================================
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
Application.EnableEvents = False
Dim ov As Variant, nv As Variant
nv = Target.Value
Application.Undo
ov = Target.Value
Target = nv
With Sheets("Log")
On Error GoTo HDL:
.Cells(Rows.Count, 1).End(xlUp)(2) = Environ("UserName")
.Cells(Rows.Count, 1).End(xlUp).Offset(, 1) = Target.Parent.Name
.Cells(Rows.Count, 1).End(xlUp).Offset(, 2) = Target.Address
If ov = "" Then
.Cells(Rows.Count, 1).End(xlUp).Offset(, 3) = "Blank"
Else
.Cells(Rows.Count, 1).End(xlUp).Offset(, 3) = ov
End If
If nv = "" Then
.Cells(Rows.Count, 1).End(xlUp).Offset(, 4) = "Blank"
Else
.Cells(Rows.Count, 1).End(xlUp).Offset(, 4) = nv
End If
.Cells(Rows.Count, 1).End(xlUp).Offset(, 5) = Now
If .Columns(6).ColumnWidth < 15 Then .Columns(6).ColumnWidth = 15
End With
HDL:
If Err.Number > 0 Then
MsgBox "The following error occurred:" & Err.Number & vbLf & Err.Description & "."
End If
Application.EnableEvents = True
End Sub