Questions:
Good Afternoon,
I found this code online to create a log of changes and I want to apply it to multiple sheets. How do I make it pull the name of the sheet where the cell was changed?
Private Sub Worksheet_Change(ByVal Target As Range)
Dim strAddress As String
Dim val
Dim dtmTime As Date
Dim Rw As Long
If Intersect(Target, Range("A:Z")) Is Nothing Then Exit Sub
'change range to suit
dtmTime = Now()
With Target
val = .Value
strAddress = .Address
End With
Rw = Sheets("Log").Range("A" & Rows.Count).End(xlUp).Row + 1
With Sheets("Log")
.Cells(Rw, 1) = strAddress
.Cells(Rw, 2) = Environ("UserName")
.Cells(Rw, 3) = dtmTime
.Cells(Rw, 4) = val
End With
End Sub
How to&Answers:
Stop using multiple Worksheet_Change event subs and switch to a single Workbook_Sheetchange in the ThisWorkbook private code sheet.
Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Select Case LCase(Sh.Name)
Case "sheet1", "sheet2", "sheet3"
If Not Intersect(Target, Sh.Range("A:Z")) Is Nothing Then
On Error GoTo exit_out
Application.EnableEvents = False
Dim rw As Long, t As Range
For Each t In Intersect(Target, Sh.Range("A:Z"))
With Worksheets("Log")
rw = Worksheets("Log").Range("A" & Rows.Count).End(xlUp).Row + 1
.Cells(rw, "A") = t.Address(0, 0)
.Cells(rw, "B") = Environ("UserName")
.Cells(rw, "C") = Now
.Cells(rw, "D") = t.Value
.Cells(rw, "E") = Sh.Name
End With
Next t
End If
Case "log"
'do nothing
End Select
exit_out:
Application.EnableEvents = True
End Sub
Tags: excelexcel
