Hello everyone, I found the following code online that tracks all the changes that might happen in a spread sheet. This macro creates a new spread sheet to track all the changes and the results are being displayed in 8 columns including many useful information such as the time and date and the user who made the changes. My problem is that I want to add 3 more columns to copy and paste values from other cells but from the same row the changes have taken place just to keep a record of the changes. All the functions I know require from the user to set the exact cell and in my case the row is acting like a parameter thus preventing me from using those functions. If someone could point me to a function that can copy a cell that is not pre-set would be great. If such a function does not exist then it would be much appreciated if someone could guide me to the solution of my problem. Thank you in advance for all the responses and your time they are really appreciated. Regards, Christos 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 ( http://vbaexpress.com/kb/getarticle.php?kb_id=909) 'http://www.mrexcel.com/forum/showthread.php?t=376400&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 - 10 ' 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 + 10)) = Array("Cell Changed", "Risk ID", "Risk Name", "Old Value", _ "New Value", "Old Formula", "New Formula", "Comments", "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, 3).Value = vOldValue .Offset(0, 5).Value = sOldFormula .Offset(0, 1).Value = Target.Value .Offset(0, 2).Value = Target.Value .Offset(0, 6).Value = Target.Value If Target.Count = 1 Then .Offset(0, 4).Value = Target.Value If Target.HasFormula Then .Offset(0, 4).Value = "'" & Target.Formula End If .Offset(0, 8) = Time .Offset(0, 9) = Date .Offset(0, 10) = Application.UserName .Offset(0, 10).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
-- Are you =EXP(E:RT) or =NOT(EXP(E:RT)) in Excel? And do you wanna be? It’s =TIME(2,DO:IT,N:OW) ! Join official Facebook page of this forum @ https://www.facebook.com/discussexcel FORUM RULES 1) Use concise, accurate thread titles. Poor thread titles, like Please Help, Urgent, Need Help, Formula Problem, Code Problem, and Need Advice will not get quick attention or may not be answered. 2) Don't post a question in the thread of another member. 3) Don't post questions regarding breaking or bypassing any security measure. 4) Acknowledge the responses you receive, good or bad. 5) Jobs posting is not allowed. 6) Sharing copyrighted material and their links is not allowed. NOTE : Don't ever post confidential data in a workbook. Forum owners and members are not responsible for any loss. --- You received this message because you are subscribed to the Google Groups "MS EXCEL AND VBA MACROS" group. To unsubscribe from this group and stop receiving emails from it, send an email to excel-macros+unsubscr...@googlegroups.com. To post to this group, send email to excel-macros@googlegroups.com. Visit this group at http://groups.google.com/group/excel-macros. For more options, visit https://groups.google.com/d/optout.
