Add Password level to change history

[vilas desai]

Dear Hans,
You had earlier helped me in creating change history, where changes that occur in certain cells in the MasterList are recorded in a sheet called Change_History. This sheet has 6 cols A:F where col A=Date / time, B=Changed By, C=Approved By, D=Old Parameter, E= new Parameter and F= Changed Cell Address.
The codes are as below for your ready reckoning.
now what I want is :
When the user selects cell in col C(row > 2) then the "Enter Password ............." msg box is popped up, the user enters one of the following two passwords 75296 or 75297, and the name corresponding to this password appears in the current cell in Col C.

The list of Passwords and their names are in sheet DV, range T2 and U2 down to T11 and U11 as below
Col T Col U
Password Name
75288 Ramesh K
75289 Sidharth Pawar
75290 Chitrakala
75291 Vinayak rao
75292 Durrani L
75293 Manoj Saraf
75294 Rajnath Singh
75295 Suresh Murthy
75296 Sayali
75297 Suryakant L


Please advise.
Best regards
Vilas Desai

Code: Select all

Option Explicit

Dim mbNoEvent As Boolean

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim vPrevValue As Variant
    Dim vCurValue As Variant
    Dim lngIndex As Long
    Dim strSource As String
    Dim strDestination As String
    Dim strList As String
    Dim wshSource As Worksheet
    Dim wshDestination As Worksheet
    Dim wshList As Worksheet
    Dim rngSource As Range
    Dim rngDestination As Range
    Dim lngRowCount As Long
    Dim lngCount As Long
    Dim wshDV As Worksheet
    Dim strPW As String
    Dim varUser As Variant

    Dim current_row As Long
    Dim column_numbers As Variant
    Dim col_counter As Long
    Static Exempt_Range As Range
    
    If mbNoEvent Then Exit Sub
    If Target.Row < 5 Or Target.Column > 27 Then Exit Sub
    If Target.Address = ActiveSheet.ListObjects(1).HeaderRowRange.Offset(ActiveSheet.ListObjects(1).ListRows.Count).Address _
        And Target.Rows.Count = 1 Then
        current_row = Target.Row
        column_numbers = Split("G,I,J,L,M,X,Y,Z", ",")
        Set Exempt_Range = Nothing
        For col_counter = LBound(column_numbers) To UBound(column_numbers)
            If Exempt_Range Is Nothing Then
               Set Exempt_Range = Range(column_numbers(col_counter) & current_row)
            Else
               Set Exempt_Range = Union(Exempt_Range, Range(column_numbers(col_counter) & current_row))
            End If
        Next
        Exit Sub
    End If
    
    If Target.Address = Target.EntireRow.Address Then Exit Sub
    If Exempt_Range Is Nothing Then
       current_row = Target.Row
       column_numbers = Split("G,I,J,L,M,X,Y,Z", ",")
       Set Exempt_Range = Nothing
       For col_counter = LBound(column_numbers) To UBound(column_numbers)
           If Exempt_Range Is Nothing Then
              Set Exempt_Range = Range(column_numbers(col_counter) & current_row)
           Else
              Set Exempt_Range = Union(Exempt_Range, Range(column_numbers(col_counter) & current_row))
           End If
       Next
    End If
    
    If Not (Application.Intersect(Target, Exempt_Range) Is Nothing) Then Exit Sub

    If Target.Count > 1 Then
        Application.EnableEvents = False
        Application.Undo
        MsgBox "Multiple cell changes are Not allowed.", vbExclamation
        Application.EnableEvents = True
        Exit Sub
    End If

    On Error GoTo ErrHandler
    mbNoEvent = True

    ' Get previous and current value
    vCurValue = Target.Value
    Application.EnableEvents = False
    Application.Undo
    vPrevValue = Target.Value
    If vPrevValue = "" Then
        Target.Value = vCurValue
    ElseIf vPrevValue = vCurValue Then
        ' Ignore
    Else
        strPW = InputBox("Enter your password")
        Set wshDV = Worksheets("DV")
        varUser = Application.VLookup(strPW, wshDV.Range("PasswordList"), 2, False)
        If IsError(varUser) Then
            MsgBox "Password invalid. Change not allowed!", vbCritical
            GoTo ExitHandler
        End If
        Target.Value = vCurValue
        Call SetHistory(varUser, vPrevValue, vCurValue, Target.Address)
    End If
    Application.EnableEvents = True

    If Intersect(Target, Me.Range("D:D")) Is Nothing Then
        If Not Intersect(Target, Me.Range("E:E")) Is Nothing Then
            Call CheckCol_E(Intersect(Target, Me.Range("E:E")).Offset(0, -1))
        End If
        GoTo ExitHandler
    End If

    Set wshList = Worksheets("List")
    If vCurValue = vPrevValue Then
        GoTo ExitHandler
    End If
    If vPrevValue <> "" Then
        lngCount = Application.WorksheetFunction.CountIf(Me.Range("D5:" & Target.Address), vPrevValue)
        ' Get info about previous source range
        lngIndex = Application.WorksheetFunction.Match(vPrevValue, wshList.Range("A:A"), 0)
        strSource = wshList.Range("B" & lngIndex)
        Set wshSource = Worksheets(strSource)
        strSource = wshList.Range("C" & lngIndex)
        Set rngSource = wshSource.Range(strSource)
        lngRowCount = rngSource.Rows.Count
        ' Get info about previous destination
        strDestination = wshList.Range("D" & lngIndex)
        Set wshDestination = Worksheets(strDestination)
        strDestination = wshList.Range("E" & lngIndex)
        Set rngDestination = wshDestination.Range(strDestination).Offset(lngCount * lngRowCount, 0)
        Set rngDestination = rngDestination.Resize(rngSource.Rows.Count, rngSource.Columns.Count)
        ' Delete
        rngDestination.Delete Shift:=xlShiftUp
    End If
    If vCurValue <> "" Then
        lngCount = Application.WorksheetFunction.CountIf(Me.Range("D5:" & Target.Address), vCurValue) - 1
        ' Get info about current source range
        lngIndex = Application.WorksheetFunction.Match(vCurValue, wshList.Range("A:A"), 0)
        strSource = wshList.Range("B" & lngIndex)
        Set wshSource = Worksheets(strSource)
        strSource = wshList.Range("C" & lngIndex)
        Set rngSource = wshSource.Range(strSource)
        lngRowCount = rngSource.Rows.Count
        ' Get info about current destination
        strDestination = wshList.Range("D" & lngIndex)
        Set wshDestination = Worksheets(strDestination)
        strDestination = wshList.Range("E" & lngIndex)
        Set rngDestination = wshDestination.Range(strDestination).Offset(lngCount * lngRowCount, 0)
        Set rngDestination = rngDestination.Resize(rngSource.Rows.Count, rngSource.Columns.Count)
        strDestination = rngDestination.Address
        rngDestination.Insert Shift:=xlDown
        Set rngDestination = rngDestination.Worksheet.Range(strDestination)
        ' Copy
        rngSource.Copy Destination:=rngDestination
        rngSource.Copy
        rngDestination.PasteSpecial Paste:=xlPasteColumnWidths
        Call UpdateValues(Target, rngDestination, wshList.Range("F" & lngIndex))
        Call CheckCol_E(Target)
    Else
        Target.Offset(0, 1) = ""
    End If

ExitHandler:
    mbNoEvent = False
    Application.EnableEvents = True
    Exit Sub

ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub

Code: Select all

Sub Clr_History()
    Dim strPW As String
    Dim strName As String
    Dim wshDV As Worksheet
Set wshDV = Worksheets("DV")
    strPW = InputBox("Enter password to clear history")
    Select Case strPW
        Case "75291", "75292", "75293"
            strName = Application.VLookup(strPW, wshDV.Range("PasswordList"), 2, False)
            Application.ScreenUpdating = False
            With Worksheets("Change_History")
                .Range("A3:G50000,F3:V50000").Clear
                .Range("A3").Value = Now
                .Range("C3").Value = strName
            End With
        Case Else
            MsgBox "You don't have permission to clear history!", vbExclamation
    End Select
End Sub

Code: Select all

Sub SetHistory(varUser, vPrevValue, vCurValue, sAddress)
    Dim wshHist As Worksheet
    Dim r As Long
    Set wshHist = Worksheets("CHANGE_HISTORY")
    r = wshHist.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
    wshHist.Cells(r, 1).Value = Now
    wshHist.Cells(r, 2).Value = varUser
    wshHist.Cells(r, 4).Value = vPrevValue
    wshHist.Cells(r, 5).Value = vCurValue
    wshHist.Cells(r, 6).Value = sAddress
End Sub

[HansV]

Do you really want a message box to pop up each time the user selects a cell in column C?

[vilas desai]

I know you have a very valid question, but please advise if you have another solution. I would love to see that

[HansV]

Please tell us what you want to accomplish...

[vilas desai]

I want to provide three levels of password to Change_history.
Level 1 and Level 3 are already done.
Level 1 makes the changes in MasterList
Level 2 approves the changes and
level 3 clears the Change_History List (by the button click)

Actually, I was thinking if this would be possible for Level 2.
We provide a 'tick box' in every cell in Col C along with every change that is recorded.
The Level 2 authority will check the tick box for as many changes he wants to approve and hit another button. "Approve Changes"
Then the password msg box will validate the approval.
The 'approve changes' button will be placed next to the "Clear History" button in the same sheet "Change_History"

Do you think this makes senses? Please advise for any other options.

Best regards
Vilas Desai

[HansV]

What exactly should "approve the changes" do?

[vilas desai]

When the change is "Approved" the approver's name should be appearing in Col C against every recorded change. In col B we have the name of the person who made the change, and in Col C we want the name of the person who approved the change.

[HansV]

Anyone could enter a name in column C, so why not provide a data validation dropdown in column C from which the user can select a name?

[vilas desai]

Very correct, that is why I earlier said that when the user selects the cell in Col c, the pop up msg will ask for the no of rows to be validated and the password of the validator. I may be wrong and correct me, but if a user selects the col C and this action will pop up the msg box then there is no opportunity to edit any name in col C. However, the idea of providing a drop down list is also excellent, except that the user will have to select a name from the list for every change as against selecting many rows at the same time. However, I dont see any problem at all in selecting the drop down list and validation by the password.

[HansV]

Below the line

Code: Select all

    If mbNoEvent Then Exit Sub

insert the following:

Code: Select all

    If Target.Column = 3 Then
        strPW = InputBox("Enter your password")
        If strPW = "75296" Or strPW = "75297" Then
            ' OK
        Else
            MsgBox "Password invalid. Change not allowed!", vbCritical
            Application.EnableEvents = False
            Application.Undo
        End If
        GoTo ExitHandler
    End If

[vilas desai]

Dear Hans,
Thank you for this code. Just a small clarification. Assuming you want me to copy the code in the wsh MasterList change event code , I did not notice any reference to the sheet "Change_History". Also, should I also add " If target.row > 2 ?
Am I missing anything in understanding.? Please advise me.
Thanks in advance and best regards
Vilas Desai

[HansV]

The code is indeed intended for the Worksheet_Change event procedure of MasterList. You can change the line

Code: Select all

    If Target.Column = 3 Then

to

Code: Select all

    If Target.Column = 3 And Target.Row > 2 Then

I thought this was only intended to allow entry in column C, so I don't see where Change_History comes in.

[vilas desai]

The col C I am refering to is in the worksheet Change_History. (please see my first tread). Please excuse me if my communication was wrong.

[HansV]

But the code that you posted is for the MasterList sheet, isn't it?

[vilas desai]

Yes, Sir. But I pasted all three codes - MasterList, Set History and Clear_History That was for your ready reference. Sorry about that.

[HansV]

OK, try the following:

Let the user enter something, e.g. "x" or "1" in column G of the Change_History sheet, in the rows that (s)he wants to approve.
Assign the following macro to the Approve Changes button:

Code: Select all

Sub ApproveChanges_Click()
    Dim r As Long
    Dim m As Long
    Dim strPW As String
    Dim strName As String
    strPW = InputBox("Enter your password")
    If strPW <> "75296" And strPW <> "75297" Then
        MsgBox "Password invalid. Change not allowed!", vbCritical
        Exit Sub
    End If
    strName = Application.VLookup(strPW, Worksheets("DV").Range("PasswordList"), 2, False)
    m = Range("G" & Rows.Count).End(xlUp).Row
    For r = 2 To m
        If Range("G" & r).Value <> "" Then
            Range("C" & r).Value = strName
            Range("G" & r).ClearContents
        End If
    Next r
    Application.ScreenUpdating = True
End Sub

P.S. You don't need the extra code in the Worksheet_Change event of MasterList. That was based on my mistaken assumption.

[vilas desai]

This is very good, Hans. Thank you for that. One thought that comes to my mind, is instead of just entering 'any' value into col G, do you agree to have a unique word written in col G which can make the user understand that if he wants to approve the change, then he should either 'tick' a 'tick box' in col G or just say 'Y' for 'yes' instead of entering any arbitrary value. i hope I make sense.
Best regards
Vilas

[HansV]

You could change the line

Code: Select all

        If Range("G" & r).Value <> "" Then

to

Code: Select all

        If Range("G" & r).Value = "Y" Then

(you can replace "Y" with another text string if you prefer)

[vilas desai]

Thank you, Hans. This works really good. One question: In the worksheet Change_history, I have two buttons - Clear History and Approve Changes. Can I have an additional button which will log changes only when this button is clicked and when the same button preferably (or another button) is clicked again, the changes are not logged.

[HansV]

Step 1:
Select File > Info, then click Properties > Advanced Properties.

S0125.png

Activate the Custom tab of the Properties dialog.
Enter LogChanges in the Name box, and select 'Yes or no' from the type dropdown.

S0126.png

Click Add, then close the Properties dialog.

Step 2:
Create a button from the Form Controls on the sheet, and name it LogChanges (in the name box on the left hand side of the address bar.
Set the button text to 'Disable Logging' (without the apostrophes).
Assign the following macro (in a standard module) to this button:

Code: Select all

Sub LogChanges_Click()
    Dim prp As DocumentProperty
    Dim btn As Button
    ' Get the LogChanges property
    Set prp = ThisWorkbook.CustomDocumentProperties("LogChanges")
    ' Toggle the value of the property
    prp.Value = Not prp.Value
    ' Get the command button
    Set btn = ActiveSheet.Buttons("LogChanges")
    ' Change the caption of the button
    If prp.Value = True Then
        btn.Caption = "Disable Logging"
    Else
        btn.Caption = "Enable Logging"
    End If
End Sub

Step 3:
Add the following lines to the beginning of the code that logs the changes:

Code: Select all

    Dim prp As DocumentProperty
    ' Get the LogChanges property
    Set prp = ThisWorkbook.CustomDocumentProperties("LogChanges")
    ' Get out if logging is disabled
    If prp.Value = False Then Exit Sub