track changes

  • Thread starter Thread starter gcplshef
  • Start date Start date
G

gcplshef

can i set up track changes on a destination workbook? it is linked to 14
different spreadsheets.
 
Does this help?
Dim vOldVal 'Must be at top of module
Private Sub Worksheet_Change(ByVal Target As Range)
Dim bBold As Boolean
Dim rArea As Range
Dim rCell As Range
For Each rArea In Target.Areas
For Each rCell In rArea
'your individual cell code here
Next rCell
Next rArea


If Target.Cells.Count > 1 Then Exit Sub
On Error Resume Next

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

If IsEmpty(vOldVal) Then vOldVal = "Empty Cell"
bBold = Target.HasFormula
With Sheet1
.Unprotect Password:="Secret"
If .Range("A1") = vbNullString Then
.Range("A1:E1") = Array("CELL CHANGED", "OLD VALUE", _
"NEW VALUE", "TIME OF CHANGE", "DATE OF CHANGE")
End If


With .Cells(.Rows.Count, 1).End(xlUp)(2, 1)
.Value = Target.Address
.Offset(0, 1) = vOldVal
With .Offset(0, 2)
If bBold = True Then
.ClearComments
.AddComment.Text Text:= _
"OzGrid.com:" & Chr(10) & "" & Chr(10) & _
"Bold values are the results of formulas"
End If
.Value = Target
.Font.Bold = bBold
End With

.Offset(0, 3) = Time
.Offset(0, 4) = Date
End With
.Cells.Columns.AutoFit
'.Protect Password:="Secret"
End With
vOldVal = vbNullString

With Application
.ScreenUpdating = True
.EnableEvents = True
End With

On Error GoTo 0
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
vOldVal = Target
End Sub

'Of course, one can add a layer of complexity, too, if multiple
'worksheets are selected:
'Dim ws As Worksheet
'Dim rArea As Range
'Dim rCell As Range
'For Each ws In ActiveWindow.SelectedSheets
'For Each rArea In ws.Range(Target.Address).Areas
'For Each rCell In rArea

'individual cell code
'Next rCell
'Next rArea
'Next ws


Or, perhaps this:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("$A$1:$b$400")) Is Nothing Then
Application.EnableEvents = False
Application.ScreenUpdating = False
With Worksheets("Sheet2")
.Select
.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Select
ActiveCell.Value = Target.Address
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Target.Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Now()
ActiveCell.NumberFormat = "mm/dd/yy"
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = InputBox("You've made a change to the Rates tab.
Please enter your name here for historical purposes.")
Application.EnableEvents = True
Application.ScreenUpdating = True
End With
End If
End Sub


Or, finally, this:
'Summary: Place this code in the Worksheet_Change() event procedure
' Every time a cell's value is changed the date, time , old value,
' new value, and the user are recorded in a comment.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim NewText As String
Dim NewVal As Variant
Dim OldText As String
Dim OldVal As Variant

Application.EnableEvents = False
NewVal = Target.Value
Application.Undo
OldVal = ActiveCell.Value
ActiveCell = NewVal
Application.EnableEvents = True

NewText = "On " & Now() & " cell changed from " & OldVal _
& " to " & NewVal & " by " & Environ("UserName")

If ActiveCell.Comment Is Nothing Then
ActiveCell.AddComment
End If

With ActiveCell.Comment
..Shape.TextFrame.AutoSize = True
OldText = .Text & vbLf
..Text Text:=OldText & NewText
End With

End Sub



Regards,
Ryan---
 
Back
Top