Track Changes in Change Hstory

[vilasdesai]

Please refer to the attachment which has cols A:P in sheet MasterList. All of the except G and H are drop downs. (Some not yet designed though). On the left of this sheet MasterList, there is another sheet by name Change_History. When ever a change is made in any drop down lists, I want a message to be popped up - Are you sure of this Change? Answer "YES" will copy the whole row into the sheet Change_History starting from Row 5 below and also add three cols : Current Date & Time, Changed by, Approved by. Rows will be populated in Change_History for every change in a col in MasterList except for Col G and Col H.
The cols "Changed by" and "Approved by "will be entered manually while the date col will be auto-updated.
If the answer is NO, the pop up msg will vanish and original values in the cols will be retained.
Any help will be greatly appreciated. Thanking in Advance.

[HansV]

Right-click the sheet tab of MasterList.
Select 'View Code' from the context menu.
Copy the following code into the worksheet module:

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
    Dim r As Long
    Dim wsh As Worksheet
    If Not Intersect(Range("A:E,G:G,I:P"), Target) Is Nothing Then
        Application.EnableEvents = False
        If MsgBox("Are you sure?", vbQuestion + vbYesNo) = vbYes Then
            Set wsh = Worksheets("CHANGE_HISTORY")
            r = wsh.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            For Each rng In Intersect(Range("A:E,G:G,I:P"), Target).Rows
                If rng.Row > 4 Then
                    r = r + 1
                    Range("A" & rng.Row).Resize(1, 16).Copy
                    wsh.Range("A" & r).PasteSpecial Paste:=xlPasteValues
                    wsh.Range("Q" & r).Value = Now
                End If
            Next rng
            Application.CutCopyMode = False
        Else
            Application.Undo
        End If
        Application.EnableEvents = True
    End If
End Sub

[vilasdesai]

Thank you again, Hans. The code executes only for the first time when the file is opened. Also it give an error msg when it ran for the first time. I have enclosed the screen shot of error file, Best regards.

[HansV]

Could you click "Debug" when the error occurs? You'll see the offending line of code highlighted in yellow. Please report that line in a reply.

[vilasdesai]

r = wsh.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

[vilasdesai]

Dear Hans, I also n=did not notice addition of Real Time date, and two other coloumns (Changed by and Checked by) in addition to the copy range. I guess I would be missing something here in not accurately understanding the code.

[HansV]

You should copy the header row of MasterList to Change_History manually, and enter the text 'Current Date & Time' in the same row in column Q, 'Changed by' in column R and 'Approved by' in column S. There is no reason to do that in the macro, since it will have to be done only once.

[vilasdesai]

OK, Hans I can do that. Do you want me to use the earlier code? I have sent you the yellow line of the coding. Thank you again.

[HansV]

You can still use the code that I posted, but before you use it, create the headers in the Change_History sheet. That should prevent the error in the highlighted line.

[vilasdesai]

Yes, it works, Sometimes it is difficult to anticipate the issues that could arise. In this particular case, when I am working in MasterList, as I move down the rows, the values in all coloumns are blank, and when I select any value for the first time, it would not be considered as a change. The change should be sensed only the cells had some initial value and then a change is encountered. I am sorry I could not forsee this issue earlier. Is this something that can be worked on? Please advise.
Also, if for example, the current value of cell D5 in Master List is Switch_Lo and I dont change it , I just again select Switch_Lo then the change should not be considered. This is my current observation
Thanks.

[HansV]

See if this version works better.

Revised_00.xlsm

[vilasdesai]

This is very very cool. Thanks a lot. I have a last follow up question on this topic. Is it possible to add col R in the Change_History sheet to indicate the value of the cell before it underwent a change. For example if the current value of Cell E5 in MasterList is Analyser and the new value becomes Burner, then I would like to see Analyser in the Col R in sheet Change_History. The header for col R would be "Value Before Change". This will make my Change Management complete. But again, a big thanks for making it so efficient, so fast and so easy to understand.

[HansV]

You can insert the header in R1 yourself.
In the code, below the line

Code: Select all

            wsh.Range("Q" & r).Value = Now

insert the line

Code: Select all

            wsh.Range("R" & r).Value = varOld

[vilasdesai]

PERFECT, thank you so much.

[vilasdesai]

Dear Hans,
I request you to check the possibility if we could implement this small change: Before asking the question :Are you Sure ? I would like the code to make the change first and then ask the question. If the answer is Yes then the entries will be made in the sheet Change_History as is done currently.
What this will achieve for me, is avoid unnecessary rows in the change history.
best regards
Vilas Desai

[HansV]

Here you go:

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
    Dim r As Long
    Dim wsh As Worksheet
    Dim varOld As Variant
    Dim varNew As Variant
    If Target.Count > 1 Then
        Beep
        Exit Sub
    End If
    If Target.Row < 4 Then
        Exit Sub
    End If
    If Not Intersect(Range("A:E,G:G,I:P"), Target) Is Nothing Then
        Application.EnableEvents = False
        varNew = Target.Value
        Application.Undo
        varOld = Target.Value
        Target.Value = varNew
        If varOld = "" Or varOld = varNew Then
            ' Ignore
        ElseIf MsgBox("Do you want to log this change?", vbQuestion + vbYesNo) = vbYes Then
            Set wsh = Worksheets("CHANGE_HISTORY")
            r = wsh.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
            wsh.Range("A" & r).Resize(1, 16).Value = Range("A" & Target.Row).Resize(1, 16).Value
            wsh.Range("Q" & r).Value = Now
            wsh.Range("R" & r).Value = varOld
        End If
        Application.EnableEvents = True
    End If
End Sub

[vilasdesai]

great, thank you so much