Log changes in a range only

G

Guest

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
 
B

Bob Phillips

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 said:
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
Click to expand...
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
Click to expand...
 
D

Dave Peterson

I think I'd do something like:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myRng As Range
Dim myCell As Range
Dim DestCell As Range

Set myRng = Me.Range("Houses")

If Intersect(myRng, Target) Is Nothing Then Exit Sub

With Worksheets("26-log")
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With

For Each myCell In Intersect(myRng, Target).Cells
With DestCell
.Value = Now
.NumberFormat = "mm/dd/yyyy hh:mm:ss"

.Offset(0, 1).Value = myCell.Address(0, 0)

If myCell.HasFormula Then
.Offset(0, 2).Value = "'" & myCell.Formula
End If

If IsError(myCell.Value) Then
.Offset(0, 3).Value = "'" & myCell.Text
Else
.Offset(0, 3).Value = "'" & myCell.Value
End If
End With
Set DestCell = DestCell.Offset(1, 0)
Next myCell

End Sub

I didn't include any of the protection stuff, though.
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
Click to expand...
 
G

Guest

Thank you very much! It is working like a dream...
--
Regards,

Martin


Bob Phillips said:
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 said:
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
Click to expand...
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
Click to expand...
Click to expand...
 
G

Guest

Many thanks Dave.
--
Regards,

Martin


Dave Peterson said:
I think I'd do something like:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myRng As Range
Dim myCell As Range
Dim DestCell As Range

Set myRng = Me.Range("Houses")

If Intersect(myRng, Target) Is Nothing Then Exit Sub

With Worksheets("26-log")
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With

For Each myCell In Intersect(myRng, Target).Cells
With DestCell
.Value = Now
.NumberFormat = "mm/dd/yyyy hh:mm:ss"

.Offset(0, 1).Value = myCell.Address(0, 0)

If myCell.HasFormula Then
.Offset(0, 2).Value = "'" & myCell.Formula
End If

If IsError(myCell.Value) Then
.Offset(0, 3).Value = "'" & myCell.Text
Else
.Offset(0, 3).Value = "'" & myCell.Value
End If
End With
Set DestCell = DestCell.Offset(1, 0)
Next myCell

End Sub

I didn't include any of the protection stuff, though.
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
Click to expand...
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Help - desparate for an expanded history log without sharing a workbook 1
Cut from one sheet, paste in another 3
Cut from one sheet, paste in another 2
Run two macros for two different sheets 11
want to change tab color based on the info in a cell. 5
Remove Alpha from AlphaNumeric String... 9
Macro will copy formula instead of value 6
simple code but it doesn't look like usual vba code 2

Top