unprotect on double click event

[roninn75]

Hi Morning

the following code on double click event is used to edit cells in the activesheet in my workbook.
the first conditional statement manages the form (FrmFind) for the user to select a name and enter it into the column range as described in the code.
the second conditional statement speaks to the next column range which on double click changes the values from 12 to 24 to nothing.
the last conditional statement is the trigger to submit to a datasheet.
however, the sheets are locked and is being unlocked with the function Uprot at the beginning of the code, which is simply

Code: Select all

ActiveSheet.unprotect "password"

the code works well but after the second conditional statement, the error "the cell is protected and therefor locked"
i don't understand this as the Uprot function should take care of that, isnt it?

your assistance is appreciated

Code: Select all

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim wsW As Worksheet
Dim wsR As Worksheet
Dim lr As Long
Set wsa = ActiveSheet
Set wsR = Sheets("Overtime Register")
Uprot
    If Not Intersect(Target, Range("D5:D46,J5:J46, P5:P46, V5:V46, AB5:AB46, AH5:AH46")) Is Nothing Then
        Cancel = True
        FrmFind.Show
    End If

    If Target.Column = 6 Or Target.Column = 12 Or Target.Column = 18 Or Target.Column = 24 Or Target.Column = 30 _
   Or Target.Column = 36 Then
   
    With Target
    lr = wsR.Range("A" & Rows.Count).End(xlUp).Row
         Select Case .Value
            Case vbNullString 'xlColorIndexNone
               '.ColorIndex = 32 'default red
               Target.Value = "12"
               Target.Font.Size = 10
               Target.Font.Color = vbBlack
               Target.Font.Bold = True
            Case 12 '32
               '.ColorIndex = 3 'default green
               Target.Value = "24"
               Target.Font.Size = 10
               Target.Font.Color = vbBlack
               Target.Font.Bold = True
            Case Else
               'Target.Interior.ColorIndex = xlNone
               Target.Value = ""
            
         End Select
         Cancel = True
      End With
   End If
   
If Target.Column = 7 Or Target.Column = 13 Or Target.Column = 19 Or Target.Column = 25 _
Or Target.Column = 31 Or Target.Column = 37 Then

    With Target.Interior
        Select Case .ColorIndex
            Case xlColorIndexNone
                .ColorIndex = 4
                If Target.Offset(0, -3).Value = "" Then
                    MsgBox "Missing data"
                Else
                    Target.Offset(0, -1).Copy wsR.Cells(Rows.Count, "B").End(xlUp).Offset(1, 0) 'hrs
                    Target.Offset(0, -3).Copy wsR.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) 'name
                    Target.Offset(0, -5).Copy wsR.Cells(Rows.Count, "D").End(xlUp).Offset(1, 0) 'stn
                    wsR.Cells(Rows.Count, "E").End(xlUp).Offset(1, 0) = ActiveSheet.Name 'date
                    wsR.Cells(Rows.Count, "H").End(xlUp).Offset(1, 0) = Environ$("USERNAME")
                    wsR.Cells(Rows.Count, "I").End(xlUp).Offset(1, 0) = Date
                    wsR.Cells(Rows.Count, "G").End(xlUp).Offset(1, 0) = Time
                End If
            Case 4
                Target.Interior.ColorIndex = xlNone
                Target.Offset(0, -1).ClearContents
                Target.Offset(0, -3).ClearContents
                Target.Offset(0, -4).ClearContents
                wsR.Cells(Rows.Count, "E").End(xlUp).Offset(1, 0).ClearContents
                wsR.Cells(Rows.Count, "H").End(xlUp).Offset(1, 0).ClearContents
                wsR.Cells(Rows.Count, "I").End(xlUp).Offset(1, 0).ClearContents
                wsR.Cells(Rows.Count, "G").End(xlUp).Offset(1, 0).ClearContents
        End Select
        Cancel = True
End With
End If
End Sub

[HansV]

Uprot only unprotects the active sheet. If the Overtime Register sheet is protected too, you'll get an error when you try to modify locked cells in that sheet. So you should add a line

Worksheets("Overtime Register").Unprotect "password"

before modifying cell in that sheet, and

Worksheets("Overtime Register").Protect "password"

afterwards.

[Rudi]

On another note, you have:

Code: Select all

Set wsa = ActiveSheet

which is not being used in the code and is not declared in the beginning either?
(unless it is a variable that is scoped more globally)

[HansV]

And the variables wsW and lr are declared but not used (the value of lr is set but the rest of the code doesn't refer to it). This won't cause an error, however.

[roninn75]

noted thanks guys. will test it now...

[roninn75]

thanks guys that was the mistake i made.
the last part of the code removes the values in the specific cells, i would also like to remove it from the "overtime register" sheet. hence the

Code: Select all

Target.Interior.ColorIndex = xlNone
                Target.Offset(0, -1).ClearContents
                Target.Offset(0, -3).ClearContents
                Target.Offset(0, -4).ClearContents
                wsR.Cells(Rows.Count, "E").End(xlUp).Offset(1, 0).ClearContents
                wsR.Cells(Rows.Count, "H").End(xlUp).Offset(1, 0).ClearContents
                wsR.Cells(Rows.Count, "I").End(xlUp).Offset(1, 0).ClearContents
                wsR.Cells(Rows.Count, "G").End(xlUp).Offset(1, 0).ClearContents

wsR = Overtime Register sheet

this is not happening though... how can i achieve this?

[Rudi]

You need to remove the Offset(1,0) statement as you are clearing the empty cell below the data.
(Assuming that content has been written to these cells - else it will delete the wrong content??)
Try this:

Code: Select all

                    wsR.Cells(Rows.Count, "E").End(xlUp).ClearContents
                    wsR.Cells(Rows.Count, "H").End(xlUp).ClearContents
                    wsR.Cells(Rows.Count, "I").End(xlUp).ClearContents
                    wsR.Cells(Rows.Count, "G").End(xlUp).ClearContents