Need help - track changes code needs tweaking
 

Hiya folks!

I got this code from ozgrid.com and modified it slightly to meet my needs
however there is one thing that I need to do and I can't seem to get it
right. When a user deletes many cells at once the results are "empty cell"
in the new value field but a null string in the old value field (with the
exception of the first cell selected). I tried another 'if then' and
imbedded a 'for each' statement when x (the number of cells selected) is
greater than 1 but its not quite right. Is there a way to do this or will I
have to reference the sheet that I am tracking this info on to get the old
value?


I really hope this makes sense. Here is a sample of what this code does:




Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)

If sh.Name = "Sheet4" Then Exit Sub

x = Target.Cells.Count
MsgBox (x)
For Each Target In Range(Target.Address).Cells

If IsEmpty(vOldVal) Then vOldVal = "Empty Cell"

On Error Resume Next


Application.EnableEvents = False
With Sheet4

.Protect Password:="Secret", UserInterFaceOnly:=True
.Cells(1, 1) = "CELL CHANGED"
.Cells(65536, 1).End(xlUp)(2, 1) = Target.Address
.Cells(1, 2) = "OLD VALUE"
.Cells(65536, 2).End(xlUp)(2, 1) = vOldVal
With .Cells(1, 3)
.Value = "NEW VALUE"
.ClearComments
End With
With .Cells(65536, 3).End(xlUp)(2, 1)

.Value = Target.Value



If IsEmpty(Target) Or 0 Then .Value = "Empty Cell"
.Font.Bold = bBold
End With
.Cells(1, 4) = "TIME OF CHANGE"
.Cells(65536, 4).End(xlUp)(2, 1) = Time
.Cells(1, 5) = "DATE OF CHANGE"
.Cells(65536, 5).End(xlUp)(2, 1) = Date
.Cells(1, 6) = "SHEET"
.Cells(65536, 6).End(xlUp)(2, 1) = sh.Name
.Cells(1, 7) = "FORMULA"
If Target.HasFormula Then
.Cells(65536, 7).End(xlUp)(2, 1) = " '" & Target.Formula & "'"
Else
.Cells(65536, 7).End(xlUp)(2, 1) = " "
End If
.Cells(1, 8) = "CELL OR RANGE"
If x = 1 Then
.Cells(65536, 8).End(xlUp)(2, 1) = "Cell"
Else
.Cells(65536, 8).End(xlUp)(2, 1) = "Range"
End If
.Cells.Columns.AutoFit
End With
vOldVal = vbNullString
Application.EnableEvents = True
On Error GoTo 0
Next

End Sub

Private Sub Workbook_SheetSelectionChange(ByVal sh As Object, ByVal Target
As Range)

For Each Target In Range(Target.Address).Cells


vOldVal = Target.Value


Next


End Sub