none
how to append the modified date and time and file name and to a text file if some one has modified the column price of the excel RRS feed

  • Question

  • Hi

    I have two excel sheet

    PriceList1.xlsx

    PriceList2.xlsx

    I wan to trace the  each changes in the files. So if there is any change in the column A,B,C ,D on an excel , I want to append the following details into the text file

    1. Date changed

    2. Time  changed

    3. File Name

    4. Column address

    I want to write the macros in workbook_before_save

    Please help


    polachan

    Tuesday, July 16, 2019 8:24 AM

All replies

  • You will need to place the Sheet Change Event code other than the Workbook Before Save Event in both the files.

    So that when data on data sheet gets changed in any of those files, the changes are stored in a string variable and will be written to a Text file during before save event.

    To implement this place the following codes as per the instructions...

    Code on Standard Module like Module1:

    Public oVal As Variant
    Public NewVal As Variant
    Public CellAddress As String
    Public ValueChanged As Boolean
    Public StrMsg As String

    Code on Sheet Module:

    Right click on the Sheet Tab--> View Code and paste the code given below into the opened code window.

    Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Skip
    If Not Intersect(Target, Range("A:D")) Is Nothing Then
        Application.EnableEvents = False
        If Target.CountLarge > 1 Then
            Application.Undo
        Else
            If Target.Value <> oVal Then
                NewVal = Target.Value
                CellAddress = Target.Address(0, 0)
                ValueChanged = True
                If StrMsg = "" Then
                    StrMsg = Date & vbTab & Time & vbTab & oVal & vbTab & NewVal & vbTab & ThisWorkbook.Name & vbTab & CellAddress
                Else
                    StrMsg = StrMsg & vbNewLine & _
                                Date & vbTab & Time & vbTab & oVal & vbTab & NewVal & vbTab & ThisWorkbook.Name & vbTab & CellAddress
                End If
                oVal = Target.Value
            End If
        End If
    End If
    Skip:
    Application.EnableEvents = True
    End Sub
    
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Not Intersect(Target, Range("A:D")) Is Nothing Then
        oVal = Target.Value
    End If
    End Sub

    Code on ThisWorkbook Module:

    Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim fso As Object
    Dim ts As Object
    Dim textFilePath As String, textFileName As String
    
    textFilePath = Environ("UserProfile") & "\Documents\Log\"   'Path where Text File will be saved.
    textFileName = "PriceListLog.txt"                           'Name of the Text File
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    If Not fso.FolderExists(textFilePath) Then
        MsgBox "The specified Text File Path doesn't exists.", vbCritical, "Unable To Save!"
        Exit Sub
    End If
    
    If Right(textFilePath, 1) <> "\" Then textFilePath = textFilePath & Application.PathSeparator
    If ValueChanged Then
        If Not fso.FileExists(textFilePath & textFileName) Then
            'If the Text File doesn't already exist, the code will create one with the following headers...
            'Date, Time, OldValue, NewValue, FileName, CellAddress
            Set ts = fso.CreateTextFile(textFilePath & textFileName)
            ts.WriteLine "Date" & vbTab & "Time" & vbTab & "OldValue" & vbTab & " NewValue" & vbTab & "FileName" & vbTab & "Cell Address"
            ts.WriteLine StrMsg
        Else
            Set ts = fso.OpenTextFile(textFilePath & textFileName, 8)
            ts.WriteLine StrMsg
        End If
        ts.Close
    End If
    ValueChanged = False
    StrMsg = ""
    End Sub




    Subodh Tiwari (Neeraj) sktneer

    Tuesday, July 16, 2019 1:09 PM
  • To:  polachan
    Re:  keeping change history

    The following code lists changes in columns(A:D) in a separate worksheet in the same workbook.
    It lists Date, Time, Cell(s) address, New value.
    You must have a sheet named "Change_List" in the workbook.  The worksheet can be hidden.
    The code goes the the worksheet module of the worksheet that you are tracking (not a standard/general module).
    '---
    Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lngRow As Long

    If Not Application.Intersect(Target.Cells, Me.Range(Me.Columns(1), Me.Columns(4))) Is Nothing Then
    With ThisWorkbook.Worksheets("Change_List")
       lngRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
      .Cells(lngRow, 1) = Date
      .Cells(lngRow, 2) = Time
      .Cells(lngRow, 3) = Target.Address(False, False)
      .Cells(lngRow, 4).Value2 = Target.Value2
    End With
    End If
    End Sub
    '---

    Example...

    Date Time Address Value
    07/16/2019 6:10:53 AM $B$5 various
    07/16/2019 6:12:03 AM $A$1 misc
    07/16/2019 6:12:06 AM $A$2 stuff
    07/16/2019 6:12:12 AM $A$3 9876
    07/16/2019 6:12:15 AM $A$4 1234
    07/16/2019 6:13:09 AM C21
    07/16/2019 6:14:08 AM B8:B13 more stuff
    07/16/2019 6:15:54 AM A17:C17 ouch
    07/16/2019 6:26:30 AM A23:D23 moar

    '---

    Special Randoms workbook (and more)
    Download form MediaFire...
    http://www.mediafire.com/folder/lto3hbhyq0hcf/Documents

    Tuesday, July 16, 2019 1:48 PM