Track Changes via Macro

[ManSim]

Hi all,
I am brandnew to VBA but learn a bit more every day. Now I have the following problem that needs your help:
I have about 15 different excel inventories and need to check every Monday if changes were made in the last week. All files are shared hence "tracking changes" is basically possible.
Now instead of clicking the mouse so many times I attempted to start recording a macro to ease my work. The result was the following code:
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o> </o>
Sub TrackChanges()
'
' TrackChanges Macro
'
<o> </o>
'
With ActiveWorkbook
.HighlightChangesOptions When:="15.03.2010"
.ListChangesOnNewSheet = True
.HighlightChangesOnScreen = True
End With
End Sub
<o> </o>
<o> </o>
Unfortunately this macro does not really work - nothing happens! What is wrong with this?
<o> </o>
PS. At a later stage I want to replace the hard coded date with an input msgbox...

Much appreciate any comment.
Thanks in advance

 

[arkusM]

Dan,

Glad you figured .target out!
Do do what you are asking I can think of one way, not the best way because it would be specific to the sheet.

One on the cell you want to monitor, make it a named range - like "Mon_Val" or whatever works for you. If you have several give them sequenced names ie. Mon_Val1, Mon_Val2 etc.
Then in the part of the code that grabs the original value of .Target add line to grab the value of the named ranges.

You will also need to add code to write the data in the tracking sheet as well.

Good luck!

No worries - Thanks for responding.
I did some research on using Target and was able to do what I needed. It just took me a while on Google to really understand what you were doing in the code,

One thing though. The only struggle I'm still having - and it may not be possible - is I'd like to grab the value of a cell that is a formula based on the one being changed (ie not the target) and can't seem to find the correct command to do that (if there is one). do you know if that's possible? It seems like short of forcing a manual calc, then grabbing the cell, and then forcing a calc might be the only solution (if that's even possible). I want to show the total budget before and after the cell change. The after part I got down. Any direction on the before part?

Thanks,
Dan

 

[skankat]

Place this code in "ThisWorkbook"
It will track all changes made anywher in the workbook and places the changes on a tab called "tracker" it also tracks formula changes.

Option Explicit
Dim sOldAddress As String
Dim vOldValue As Variant
Dim sOldFormula As String
Private Sub Workbook_TrackChange(Cancel As Boolean)
 
Dim sh As Worksheet
For Each sh In ActiveWorkbook.Worksheets
sh.PageSetup.LeftFooter = "&06" & ActiveWorkbook.FullName & vbLf & "&A"
Next sh
End Sub
Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
'''''''''''''''''''''''''''''''''''''''''''''
'Thanks to lenze for getting me started on this project ([URL]http://vbaexpress.com/kb/getarticle.php?kb_id=909[/URL])
'http://www.mrexcel.com/forum/excel-questions/376400-vba-ignoring-exit-sub-select-all.html?referrerid=76744 'Thanks to Colin_L
'Adapted by Mark Reierson 2009
'''''''''''''''''''''''''''''''''''''''''''''
 
Dim wSheet As Worksheet
Dim wActSheet As Worksheet
Dim iCol As Integer
Set wActSheet = ActiveSheet
 
'Precursor Exits
'Other conditions that you do not want to tracke could be added here
If vOldValue = "" Then Exit Sub 'If you comment out this line *every* entry will be recorded
 
'Continue
 
On Error Resume Next ' This Error-Resume-Next is only to allow the creation of the tracker sheet.
Set wSheet = Sheets("Tracker")
'**** Add the tracker Sheet if it does not exist ****
 
If wSheet Is Nothing Then
Set wActSheet = ActiveSheet
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Tracker"
End If
On Error GoTo 0
'**** End of specific error resume next
 
On Error GoTo ErrorHandler
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
 
With Sheets("Tracker")
'******** This bit of code moves the tracker over a column when the first columns are full**'
If .Cells(1, 1) = "" Then '
iCol = 1 '
Else '
iCol = .Cells(1, 256).End(xlToLeft).Column - 7 '
If Not .Cells(65536, iCol) = "" Then '
iCol = .Cells(1, 256).End(xlToLeft).Column + 1 '
End If '
End If '
'********* END *****************************************************************************'
.Unprotect Password:="Secret"
 
'******** Sets the Column Headers **********************************************************
If LenB(.Cells(1, iCol).Value) = 0 Then
.Range(.Cells(1, iCol), .Cells(1, iCol + 7)) = Array("Cell Changed", "Old Value", _
"New Value", "Old Formula", "New Formula", "Time of Change", "Date of Change", "User")
.Cells.Columns.AutoFit
End If
With .Cells(.Rows.Count, iCol).End(xlUp).Offset(1)
 
.Value = sOldAddress
.Offset(0, 1).Value = vOldValue
.Offset(0, 3).Value = sOldFormula
 
If Target.Count = 1 Then
.Offset(0, 2).Value = Target.Value
If Target.HasFormula Then .Offset(0, 4).Value = "'" & Target.Formula
End If
 
.Offset(0, 5) = Time
.Offset(0, 6) = Date
.Offset(0, 7) = Application.UserName
.Offset(0, 7).Borders(xlEdgeRight).LineStyle = xlContinuous
End With
 
'.Protect Password:="Secret" 'Uncomment to protect the "tracker tab"
 
End With
ErrorExit:
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
 
wActSheet.Activate
Exit Sub
 
ErrorHandler:
'any error handling you want
'Debug.Print "We have an error"
Resume ErrorExit
 
End Sub
 
Private Sub Workbook_SheetSelectionChange(ByVal sh As Object, ByVal Target As Range)
 
With Target
sOldAddress = .Address(external:=True)
 
If .Count > 1 Then
 
vOldValue = "Multiple Cell Select"
sOldFormula = vbNullString
 
Else
 
vOldValue = .Value
If .HasFormula Then
sOldFormula = "'" & Target.Formula
Else
sOldFormula = vbNullString
End If
End If
End With
End Sub

This code is looks good and working for manual changes in the script. But I am looking for the one which tracks changes happen for records added and deleted using a user form.

Can any one help me?
Thanks in advanced.