Allow users to edit ranges when protecting worksheet 1

[Adgat]

I have a spreadsheet that sorts and reorders data automatically after a user makes a change to the data. This is done through Private Sub Worksheet_Change. Part of the code is to unprotect the sheet and than protect it again after changes have been made. I am using the 'Allow users to edit ranges' feature so that some user can edit some columns while others can edit all of them. They are required to enter a password when they try to change a cell. The problem is that they are prompted to enter the password on every cell they try to edit. They should only be required to enter the password once. I have narrowed to problem down to the "Sheet("Sheet1").protect" code in the Worksheet_Change sub. It seems to reset the password protection on the 'Allow users to edit ranges". Does anyone know a way around this?

Here is the code. The problems still happens if I remove everything and leave only "Sheet("Sheet1").protect".

Private Sub Worksheet_Change(ByVal Tgt As Range)


    Const iPriCol As Long = 1 ' column containing task priority
    Const iRowBeg As Long = 2 ' first row in range

    Dim r As Range
    Dim iRowEnd As Long ' last row in range
    Dim iRow As Long ' row index
    Dim OrigPriority As Long
    Dim NewPriority As Long
    Dim PromoDemo As String

    Sheets("Sheet1").Select
    iRowEnd = Cells(100, iPriCol).End(xlUp).Row ' last non-blank cell in priority column
    Set r = Cells(iRowBeg, iPriCol).Resize(iRowEnd - iRowBeg + 1).EntireRow

    If Tgt.Rows.Count = 1 And Tgt.Columns.Count = 1 Then
        If Tgt.Column = iPriCol And Not Intersect(Tgt, r) Is Nothing Then
            Application.EnableEvents = False

            NewPriority = Tgt
            Application.Undo

            OrigPriority = Tgt

            If NewPriority > OrigPriority Then PromoDemo = "Promote"
            If NewPriority < OrigPriority Then PromoDemo = "Demote"
            If NewPriority = OrigPriority Then PromoDemo = "NoChange"

            If PromoDemo = "Demote" Then
                For iRow = iRowBeg To iRowEnd
                    If iRow = Tgt.Row Then
                        Cells(iRow, iPriCol) = NewPriority
                    Else
                        If Cells(iRow, iPriCol) < OrigPriority And Cells(iRow, iPriCol) >= NewPriority Then
                            Cells(iRow, iPriCol) = Cells(iRow, iPriCol) + 1
                        End If
                    End If
                Next iRow
            ElseIf PromoDemo = "Promote" Then
                For iRow = iRowBeg To iRowEnd
                    If iRow = Tgt.Row Then
                        Cells(iRow, iPriCol) = NewPriority
                    Else
                        If Cells(iRow, iPriCol) > OrigPriority And Cells(iRow, iPriCol) <= NewPriority Then
                            Cells(iRow, iPriCol) = Cells(iRow, iPriCol) - 1
                        End If
                    End If
                Next iRow
            End If


            Application.EnableEvents = True
        End If

        Sheets("Sheet1").Unprotect (3250)
        Range("A2:F46").Sort _
        Key1:=Range("A2"), Order1:=xlAscending, _
         Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
         Orientation:=xlTopToBottom
         Sheets("Sheet1").Protect (3250)

    End If


End Sub

 

[SkipVought]

Hi,

Very clumsy!

Part of the code is to unprotect the sheet and than protect it again after changes have been made

Not so! The USER must unprotect the sheet and can only make ONE change. Then some other changes may happen in the code and then the table is sorted and THEN the sheet is protected. Very VERY clumsy!

Why not restrict access to the workbook with a password, modify the sheet protect parameters to ONLY allow changes to the columns that are permitted. If there must be a sort that affects protected cells, do that in the Workbook_BeforeSave event, where you can unprotect, perform whatever and then protect.

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[Adgat]

Moving the code that sorted by priority to Workbook_BeforeSave was the trick. Thank you!

 

[James Wallace]

Wow, this is a great idea.