Log changes in a range only
Test it
If Intersect(Target,Me.Range("Houses")) Is Nothing Then Exit Sub
--
HTH
Bob Phillips
(replace somewhere in email address with gmail if mailing direct)
"Martin" wrote in message
...
Dear All,
The code below is working when I want to log changes within an entire
sheet.
But how do I change the code to log changes in a particular named range,
lets
assume the named range is [Houses].
Any help much appreciated.
Private Sub Worksheet_Change(ByVal Target As Range)
' Insert changes made into Log sheet
Dim Col As Long
Dim Row As Long
Dim Lastrow As Long
Lastrow = ActiveWorkbook.Sheets("26-Log").[B1].Value
If Target.Columns.Count 1 Or Target.Rows.Count 1 Then
For Col = Target.Column To Target.Column + Target.Columns.Count -
1
For Row = Target.Row To Target.Row + Target.Rows.Count - 1
If Cells(Row, Col).HasFormula Then
ActiveWorkbook.Sheets("26-log").Unprotect
Password:="log"
ActiveWorkbook.Sheets("26-log").Cells(Lastrow + 1, 1)
=
("Sheet: " & Target.Worksheet.Name & " Cell: " & _
Target.Address & " has changed to formula: " &
Cells(Row, Col).Formula) & " (Date: " & Date & " at" & " Time: " & Time &
")"
Else
ActiveWorkbook.Sheets("26-log").Unprotect
Password:="log"
ActiveWorkbook.Sheets("26-log").Cells(Lastrow + 1, 1)
=
("Sheet: " & Target.Worksheet.Name & " Cell: " & _
Target.Address & " has changed to value: " &
Cells(Row,
Col).Value) & " (Date: " & Date & " at" & " Time: " & Time & ")"
End If
Next Row
Next Col
Else
If Target.HasFormula Then
ActiveWorkbook.Sheets("26-Log").Unprotect Password:="log"
ActiveWorkbook.Sheets("26-Log").Cells(Lastrow + 1, 1) =
"Sheet:
" & Target.Worksheet.Name & " Cell: " & _
Target.Address & " has changed to formula: " & Target.Formula
&
" (Date: " & Date & " at" & " Time: " & Time & ")"
Else
ActiveWorkbook.Sheets("26-Log").Unprotect Password:="log"
ActiveWorkbook.Sheets("26-Log").Cells(Lastrow + 1, 1) =
"Sheet:
" & Target.Worksheet.Name & " Cell: " & _
Target.Address & " has changed to value: " & Target.Value & "
(Date: " & Date & " at" & " Time: " & Time & ")"
End If
End If
'Increase the LastRow value by 1
ActiveWorkbook.Sheets("26-Log").[B1].Value = Lastrow + 1
ActiveWorkbook.Sheets("26-Log").Protect Password:="log"
Application.ScreenUpdating = True
End Sub
--
Regards,
Martin
|