I prepare a weekly planing workbook and would like to have the workbook
highlight any changes made. The workaround file I have now is too
big:-( Any help is appreciated:-)
--
jojojojo5
------------------------------------------------------------------------
jojojojo5's Profile: http://www.excelforum.com/member.php?action=getinfo&userid=36719
View this thread: http://www.excelforum.com/showthread.php?threadid=564480
On Error GoTo ws_exit:
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target
.Interior.ColorIndex = 38
End With
End If
ws_exit:
Application.EnableEvents = True
End Sub
'This is worksheet event code, which means that it needs to be
'placed in the appropriate worksheet code module, not a standard
'code module. To do this, right-click on the sheet tab, select
'the View Code option from the menu, and paste the code in.
--
HTH
Bob Phillips
(replace somewhere in email address with gmail if mailing direct)
"jojojojo5" <jojojojo5.2bgwhu...@excelforum-nospam.com> wrote
in message news:jojojojo5.2bgwhu...@excelforum-nospam.com...
1. How do you modify this macro so you can turn it ON and OFF?
Attached below is another macro (I've also attached the file with the
macros) that documents the changes on a hidden worksheet, with these to
macros combined I'm basically recreating the 'Track Changes" feature in
excel except I'm not losing an excel features that a "Shared Workbook"
can't provide.
2. How do I modify this code to add the "User Name" and "SheetName"?
This code goes in the "Workbook" module and the other code is inserted
into each worksheet.
Dim vOldVal 'Must be at top of module
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Range)
Dim bBold As Boolean
If Target.Cells.Count > 1 Then Exit Sub
On Error Resume Next
If IsEmpty(vOldVal) Then vOldVal = "Empty Cell"
bBold = Target.HasFormula
Application.EnableEvents = False
With Sheet1
.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"
End With
With .Cells(65536, 3).End(xlUp)(2, 1)
.Value = Target
.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.Columns.AutoFit
End With
vOldVal = vbNullString
Application.EnableEvents = True
On Error GoTo 0
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal
Target As Range)
vOldVal = Target
End Sub
Any help is greatly appreciated!!!!!
"jojojojo5" <jojojojo5.2bk78r...@excelforum-nospam.com> wrote
in message news:jojojojo5.2bk78r...@excelforum-nospam.com...
>
> THANK YOU SO MUCH, I knew someone out there had the answer. I have one
> maybe two more questions:-)
>
> 1. How do you modify this macro so you can turn it ON and OFF?
Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "A1:H10"
Const fON As Boolean = TRUE '<=== change this
On Error GoTo ws_exit:
if fON Then
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target
.Interior.ColorIndex = 38
End With
End If
End If
ws_exit:
Application.EnableEvents = True
End Sub
> Attached below is another macro (I've also attached the file with the
> macros) that documents the changes on a hidden worksheet, with these to
> macros combined I'm basically recreating the 'Track Changes" feature in
> excel except I'm not losing an excel features that a "Shared Workbook"
> can't provide.
>
> 2. How do I modify this code to add the "User Name" and "SheetName"?
Option Explicit
Dim vOldVal 'Must be at top of module
Private Sub Workbook_SheetChange(ByVal Sh As Object, _
ByVal Target As Range)
Dim bBold As Boolean
Dim iLastRow As Long
If Target.Cells.Count > 1 Then Exit Sub
On Error Resume Next
If IsEmpty(vOldVal) Then vOldVal = "Empty Cell"
bBold = Target.HasFormula
Application.EnableEvents = False
With Sheet1
.Cells(1, "A").Value = "CELL CHANGED"
.Cells(1, "B").Value = "OLD VALUE"
.Cells(1, "C").Value = "NEW VALUE"
.Cells(1, "D").Value = "TIME OF CHANGE"
.Cells(1, "E").Value = "DATE OF CHANGE"
.Cells(1, "F").Value = "USER"
.Cells(1, "G").Value = "SHEET"
iLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Protect Password:="Secret", UserInterFaceOnly:=True
.Cells(iLastRow, "A").Value = Target.Address
.Cells(iLastRow, "B").Value = vOldVal
With .Cells(iLastRow, "C")
.Value = Target
.Font.Bold = bBold
End With
.Cells(iLastRow, "D").Value = Time
.Cells(iLastRow, "E").Value = Date
.Cells(iLastRow, "F").Value = Environ("UserName")
.Cells(iLastRow, "G").Value = Me.Name
.Cells.Columns.AutoFit
End With
vOldVal = vbNullString
Application.EnableEvents = True
On Error GoTo 0
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, _