Change History with Password Protection.

[DVM]

Dear Hans, you had earlier given me a code for implementing change history, which I used and found perfect, however though I am trying to make it a bit more simpler and with lesser details. I am separately sending you this file by email because of a larger memory size. Please refer to sheet Change_History which has 6 cols : Date & Time, Changed by , Approved by, Address of Changed Value, Changed Value and Previous Value. When a change is made (only when there was a previous value and not when the previous value was blank) a message is popped up - Please Enter Password" xxxx and if the Password matches with a list of given password the change is accepted. If not, a message "Invalid Password" is popped up. A Cancel Button will not make the change and returns the previous value. The validated change is reflected in the wsh Change_History. The new changes are added in subsequent rows. Under the col heading 'Changed By', a look-up table will look for the name of the person corresponding to the password he entered and edit his name. Under the col "Cell Address", the address of the cell which got changed will be found. Finally we have the two cols which are Previous Parameter and Changed Parameter. The col for "Approved By" will be manually entered.

The link to your earlier code is
http://www.eileenslounge.com/viewtopic. ... 63#p126063

I am nearing end of this project and your immense help has made me reach so far. I have also added a new feature today which is a code value for button click, which creates drawings based on the values in Loop_Data worksheet. I think the final feature will be the one which we discussed earlier and found it was a bit absurd to implement
I am trying to find the work round for that and hopefully I should get some trick for that.

Thanks a lot once again and with best regards
Vilas Desai

[HansV]

I'll take a look at your workbook later today.

[DVM]

Thanks a lot

[HansV]

Where should the code get the list of passwords and usernames from? Is this list stored on a worksheet?

[DVM]

Sorry about not giving the info earlier
The info would be stored in a sheet called DV
Ideally I would like the code to be flexible to take any amount of names and passwords.
The password size can be restricted to 5 alpha numeric characters with no rules.
Example
Names Passwords
Ramesh K 75288
Sidharth Pawar 75289
Chitrakala 75290
Shifaq Shah 75291
Durrani L 75292
Manoj Saraf 75293
Rajnath Singh 75294
Suresh Murthy 75295
Sayali 75296
Suryakant L 75297


Thnnks and best regard
Vilas Desai

[HansV]

I have entered the passwords in column T and the usernames in column U of the DV sheet:

S0046.png

Next, I created a dynamic named range PasswordList, defined as

=OFFSET(DV!$T$1,1,0,COUNTA(DV!$T:$T)-1,2)

This will grow/shink automatically as you add/remove passwords.

We will use this named range later on.

Which range on MasterSheet do you want to keep a history of changes for? Are there specific situations (except the ones you mentioned above) in which you do or do not want to track the change? Please specify it now instead of afterwards.

[DVM]

Hello Hans,
Thank you for your questions.
As I have shown in the sheet change_history, I have only two cols identified for the changes that actually take place.
1. Col D for Old parameter and 2. Col E for New Parameter. In reality, any of the col values can change from A to X except those hidden. If I have to show all these parameters in the Change_Hostory wsh it occupies a lot of space (and memory too.) Therefore I thought it is worthwhile to only indicate which parameter has changed from its previous value.
In order that the user does not have to search for this change, I have used another col for indicating the cell address which is changed. This way, by default if several cell values change in the same row they will all be listed one after the other in subsequent rows.
I am actually short of idea on how to handle changes that take place due to formulas. (Can you please advise me on what is an accepted approach. )
Am I talking sensible?
Best regards
Vilas Desai

[HansV]

Worksheet_Change ignores cells with formulas, since their values aren't directly changed by the user, but are the result of changes to other cells.
So would it be safe to say that you want to look at direct changes in columns A:X in row 5 and down?
I assume that you want to ignore inserting or deleting an entire row.

[DVM]

Yes we can ignore inserted / deleted rows. However, the cells in Col J under the heading "Device Tag" is the most important indication for identifying a change because this cell is unique for every device / row. Is it possible to include this in the change-history knowing that it is a formula based value?

[DVM]

Also, for deleted rows can we say that
Old Parameter = ......
New parameter = 'Deleted"
Please note that a row can be deleted only when cell D is first deleted.

[HansV]

The combination of the code for columns K, N and P with the code to track history is too complicated, so those columns will be ignored.
We can't handle changes in column J, nor deleting rows.

Here is the modified Worksheet_Change event procedure:

Code: Select all

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

    If mbNoEvent Then Exit Sub
    If Target.Address = ActiveSheet.ListObjects(1).HeaderRowRange.Offset(ActiveSheet.ListObjects(1).ListRows.Count).Address _
        And Target.Rows.Count = 1 Then Exit Sub

    If Target.Address = Target.EntireRow.Address 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
    Target.Value = vCurValue
    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
        Exit Sub
    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

It calls

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

I will send you the workbook by e-mail.

[DVM]

Dear Hans. Thanks a lot. I tested it and here is my observation: It works correctly for the first change, the the code stops running, I close the file - reopen it and again it works for the first time. I did this on 5 occasions and found the same results. I guess This happened after I entered a wrong password because before that I could log two changes without crashing the program. Am I dong something wrong here? Best regards Vilas Desai

[DVM]

I tested it again by again downloading the file and saving it with a different name, but it works for only the first change, so the theory of entering a wrong password is incorrect.

[HansV]

I'm sorry, I forgot to remove one line from the Worksheet_Change procedure.

Code: Select all

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

    If mbNoEvent Then Exit Sub
    If Target.Address = ActiveSheet.ListObjects(1).HeaderRowRange.Offset(ActiveSheet.ListObjects(1).ListRows.Count).Address _
        And Target.Rows.Count = 1 Then Exit Sub

    If Target.Address = Target.EntireRow.Address 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
        Exit Sub
    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

[DVM]

Oh, I see. It would be around 3 am in your country and you guys you dont rest? Amazing.
Do you advise me to copy this code into the wb or do you advise me till you could send the revised file. I would prefer the file to avoid my mistakes and come back to you to correct it.

[HansV]

I've sent you the revised workbook.

(It's early, but not that early...)

[DVM]

How early is "not that early" ?
Sorry about it but is the new file is still missing your revised code?
And what cols are considered for a change. I know we spoke about formula based cells not considered but how about manually entered cols?

[HansV]

I see. I have sent you a new version.

In the part

Code: Select all

    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
        Exit Sub
    End If

(It was almost 5:00 local time when you wrote "It would be around 3 am in your country".)
the line Exit Sub has been replaced with GoTo ExitHandler.

[HansV]

Oh, I forgot to mention that he code applies to columns A, B, D, E, F, H, I, O, R, S, T, U, V, W, and to columns AA and further (but those aren't used).
Columns C, G, Q, Y and Z are hidden, so the user cannot enter values in them.
Columns J, L, M and X contain formulas, so the Worksheet_Change event does not apply to those.
Columns K, N and P are handled separately.

[DVM]

Great! Absolutely Great! works very good now. Thank you so much.
"Columns K, N and P are handled separately." What does this mean? Are we logging these changes differently? I though we are not logging them.