View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Bob Phillips Bob Phillips is offline
external usenet poster
 
Posts: 10,593
Default If target.count 1

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