The Below code is working great -IF THE USER ONLY makes
small one-cell changes in any of the sheets other than "ChangeLog".
If however they were to select or highlight multiple cells and say delete
the below bombs (obvioulsy) - you can see where I'm commented out
a few lines to allow for that, but still I'd like to somehow be able to
log Multi-Cell changes. Is that possible?
Thanks in Advance...

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.EnableEvents = False
Dim lrow As Integer
Dim oldVal As String
Dim NVal As String ' New Value
'If Target.Count 1 Then GoTo BailOut
'If Target.Value = "" Then GoTo BailOut
If ActiveSheet.Name < "ChangeLog" Then
If Not Intersect(ActiveCell, Columns("A:AZ")) Is Nothing Then
With Sheets("ChangeLog")
NVal = Target.Value
Application.Undo
oldVal = Target.Value
lrow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Cells(lrow, 1) = ActiveCell.Address 'Cell Address
.Cells(lrow, 2) = ActiveSheet.Name
.Cells(lrow, 3) = oldVal
.Cells(lrow, 4) = NVal
.Cells(lrow, 5) = Application.UserName
.Cells(lrow, 6) = Now()
End With
End If
Target.Value = NVal
End If
'BailOut:
Application.EnableEvents = True
'Exit Sub
End Sub

Not tested, but hopefully I caught all the bits

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim cell As Range
Dim lrow As Long
Dim oldVal As String
Dim NVal As String ' New Value

Application.EnableEvents = False
On Error GoTo BailOut
If Me.Name < "ChangeLog" Then
For Each cell In Target
If Not Intersect(cell, Columns("A:AZ")) Is Nothing Then
With Sheets("ChangeLog")
NVal = cell.Value
Application.Undo
oldVal = cell.Value
lrow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Cells(lrow, 1) = cell.Address 'Cell Address
.Cells(lrow, 2) = Me.Name
.Cells(lrow, 3) = oldVal
.Cells(lrow, 4) = NVal
.Cells(lrow, 5) = Application.UserName
.Cells(lrow, 6) = Now()
End With
End If
cell.Value = NVal
Next cell
End If
BailOut:
Application.EnableEvents = True
'Exit Sub
End Sub

--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

"Jim May" wrote in message
...
The Below code is working great -IF THE USER ONLY makes
small one-cell changes in any of the sheets other than "ChangeLog".
If however they were to select or highlight multiple cells and say delete
the below bombs (obvioulsy) - you can see where I'm commented out
a few lines to allow for that, but still I'd like to somehow be able to
log Multi-Cell changes. Is that possible?
Thanks in Advance...

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Range)
Application.EnableEvents = False
Dim lrow As Integer
Dim oldVal As String
Dim NVal As String ' New Value
'If Target.Count 1 Then GoTo BailOut
'If Target.Value = "" Then GoTo BailOut
If ActiveSheet.Name < "ChangeLog" Then
If Not Intersect(ActiveCell, Columns("A:AZ")) Is Nothing Then
With Sheets("ChangeLog")
NVal = Target.Value
Application.Undo
oldVal = Target.Value
lrow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Cells(lrow, 1) = ActiveCell.Address 'Cell Address
.Cells(lrow, 2) = ActiveSheet.Name
.Cells(lrow, 3) = oldVal
.Cells(lrow, 4) = NVal
.Cells(lrow, 5) = Application.UserName
.Cells(lrow, 6) = Now()
End With
End If
Target.Value = NVal
End If
'BailOut:
Application.EnableEvents = True
'Exit Sub
End Sub

This needs fleshing out but I use an array to store the old values so it
needs only two undos:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim SaveArray() As Variant
Dim Cell As Range
Dim Counter As Long
Application.EnableEvents = False
ReDim SaveArray(1 To Target.Cells.Count, 1 To 6)
Application.Undo
With Worksheets("Save")
For Each Cell In Target.Cells
Counter = Counter + 1
SaveArray(Counter, 1) = Cell.Address
SaveArray(Counter, 2) = Cell.Value ''Old val
''etc
Next
Counter = 0
Application.Undo
For Each Cell In Target.Cells
Counter = Counter + 1
SaveArray(Counter, 3) = Cell.Value ''New val
Next
Worksheets("Save").Range("A65536").End(xlUp) _
.Offset(1).Resize(Counter, 6).Value = SaveArray
End With
Application.EnableEvents = True
End Sub

Thanks Guys -- I'll pursue your ideas/code,,
Jim

"Jim Rech" wrote:

This needs fleshing out but I use an array to store the old values so it
needs only two undos:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim SaveArray() As Variant
Dim Cell As Range
Dim Counter As Long
Application.EnableEvents = False
ReDim SaveArray(1 To Target.Cells.Count, 1 To 6)
Application.Undo
With Worksheets("Save")
For Each Cell In Target.Cells
Counter = Counter + 1
SaveArray(Counter, 1) = Cell.Address
SaveArray(Counter, 2) = Cell.Value ''Old val
''etc
Next
Counter = 0
Application.Undo
For Each Cell In Target.Cells
Counter = Counter + 1
SaveArray(Counter, 3) = Cell.Value ''New val
Next
Worksheets("Save").Range("A65536").End(xlUp) _
.Offset(1).Resize(Counter, 6).Value = SaveArray
End With
Application.EnableEvents = True
End Sub