A small adjustment needed to an existing code

[palaeontology]

Hi, I'm currently using the following code ... it allows me to double click on a cell in the range A8:A400, which then transfers the data from that cell over to the first available cell of a different sheet in the range LeftSubject!A8:A400. If double clicked again, it undoes that action.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)Dim LS As Range, c As Range, MySwitch As Boolean


    If Intersect(Target, Range("A8:A400")) Is Nothing Then Exit Sub
    Set LS = Sheets("LeftSubject").Range("A8:A400")
    
    If Target.Interior.ColorIndex = 3 Then
        Target.Interior.ColorIndex = xlNone
        MySwitch = False
        For Each c In LS
            If c.Value = Target.Value Or MySwitch Then
                c.Value = c.Offset(1, 0).Value
                c.Offset(0, 4).Value = c.Offset(1, 4).Value
                MySwitch = True
            End If
            If c.Value = "" Then Exit Sub
        Next c
    Else
        Target.Interior.ColorIndex = 3
        Set c = LS.Offset(-1).Find("")
        c.Value = Target.Value
        c.Offset(0, 4) = Now
    End If
    
End Sub

However, the cells that the user might double click on (ie: range A8:A400 of the worksheet where the code is saved) I need them to be password protected, but, of course, the current code (shown above) doesn't work if those cells are protected.

Is there something I can add to the code that, in the act of double clicking, undoes the password, carries out the required action, then puts the password protection back into place ?

The password is ... Malibu00 ... if you need it for the code.

Very kind regards,

Chris

 

[Peter_SSs]

Is there something I can add to the code that, in the act of double clicking, undoes the password, carries out the required action, then puts the password protection back into place ?

You can do that, but a better way might be this.
- Unprotect the sheet manually
- Run this one-line macro which protects the sheet for a user actually using the sheet, but leaves it free for code to interact without password.

Edit sheetname of course to the sheet you want protected

Sub Protect_UIO()
  Sheets("sheetname").Protect Password:="Malibu00", UserInterfaceOnly:=True
End Sub

Note that there are other options when protecting a sheet, so if you want any of those the code may need tweaking. You could again unprotect manually, then record a macro of protecting with the features you want to help get the required code.

 

[palaeontology]

Hi Peter,

I tried your code, and I'm sure it works, but I like the idea of simply deactivating the password, letting the code do what it does, then reactivating the password.

So would my code now look like this ?

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)Dim LS As Range, c As Range, MySwitch As Boolean
    ActiveSheet.Unprotect


    If Intersect(Target, Range("A8:A400")) Is Nothing Then Exit Sub
    Set LS = Sheets("LeftSubject").Range("A8:A400")
    
    If Target.Interior.ColorIndex = 3 Then
        Target.Interior.ColorIndex = xlNone
        MySwitch = False
        For Each c In LS
            If c.Value = Target.Value Or MySwitch Then
                c.Value = c.Offset(1, 0).Value
                c.Offset(0, 4).Value = c.Offset(1, 4).Value
                MySwitch = True
            End If
            If c.Value = "" Then Exit Sub
        Next c
    Else
        Target.Interior.ColorIndex = 3
        Set c = LS.Offset(-1).Find("")
        c.Value = Target.Value
        c.Offset(0, 4) = Now
    End If
    
    ActiveSheet.Protect


End Sub

However, I tried this code, and it's still telling me the cell I'm trying to click on is protected.

I really do thank you very much for your help on this.

Kind regards,

Chris

 

[Peter_SSs]

You still have to provide the password for Unprotecting/Protecting

ActiveSheet.Unprotect Password:="Malibu00"

' Other code

ActiveSheet.Protect Password:="Malibu00"

 

[palaeontology]

Thankyou again Peter.

I did forget to put the actual password into the code.

Ok, so the new code allows me to double click and carry out the transfer of data, by turning the password off at the beginning and then back on after the procedure is completed, however, I'm still getting the pop-up message saying ... "The cell or chart you're trying to change is on a protected sheet. To make changes, click Unprotect Sheet in the Review tab (you might need a password)."

Is there any way to avoid having that message coming up when double clicking in the range A8:A400 on this sheet. I still need that message to appear if the user tries to enter the other protected cells on that sheet though.

Also, a strange thing is happening. The original double click event works correctly ... highlighting the cell red, and transferring the data from that clicked cell, and then reinstating the password protection, however, if I double click that same cell again to undo the transfer, the red fill of the cell is undone and the transfer is undone (as it's meant to do) but the password is not re-instated, so no matter how many double clicks i do on other cells (in that A8:A400 range) from that moment on, the sheet is left, at the end of it, unprotected.

Any ideas ?

Very kind regards,

Chris

 

[Peter_SSs]

It sounds to me like the sheet "LeftSubject" is also protected. Is that the case? If so, your code would need to also Unprotect/Protect that sheet before it could make changes to it.
If that doesn't help you resolve the issue, then when the code errors, click Debug and report which line the code errored on (highlighted yellow).

BTW, there would be a more direct way to find and remove a value from "LeftSubject" than looping right from the top to the bottom. I'd be happy to suggest code if you are interested in that.

 

[palaeontology]

Hi again Peter,

this is the code I'm now using ...

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)    Dim LS As Range, c As Range, MySwitch As Boolean
    
    ActiveSheet.Unprotect Password:="Malibu00"
    Sheets("LeftSubject").Select
    ActiveSheet.Unprotect Password:="Malibu00"
    Sheets("Entry").Select
    Range("A7").Select




    If Intersect(Target, Range("A8:A400")) Is Nothing Then Exit Sub
    Set LS = Sheets("LeftSubject").Range("A8:A400")
    
    If Target.Interior.ColorIndex = 3 Then
        Target.Interior.ColorIndex = xlNone
        MySwitch = False
        For Each c In LS
            If c.Value = Target.Value Or MySwitch Then
                c.Value = c.Offset(1, 0).Value
                c.Offset(0, 4).Value = c.Offset(1, 4).Value
                MySwitch = True
            End If
            If c.Value = "" Then Exit Sub
        Next c
    Else
        Target.Interior.ColorIndex = 3
        Set c = LS.Offset(-1).Find("")
        c.Value = Target.Value
        c.Offset(0, 4) = Now
    End If
    
    ActiveSheet.Protect Password:="Malibu00"
    Sheets("LeftSubject").Select
    ActiveSheet.Protect Password:="Malibu00"
    Sheets("Entry").Select
    Range("A7").Select




End Sub

However, even though I've included code at the end to reactivate the password protection of both sheets, they are still not being protected.

The original re-protection code (as found by recording a macro) was this ...

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Sheets("LeftSubject").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Sheets("Entry").Select
    Range("A7").Select

However, in adding the actual password itself into the code (Malibu00), both these lines were causing an error message, so I removed them. If their removal is the cause of the two sheets not being re-protected, can you please let me know how to include those lines without error ?

DrawingObjects:=True, Contents:=True, Scenarios:=True

Kind regards,

Chris

 

[Peter_SSs]

However, even though I've included code at the end to reactivate the password protection of both sheets, they are still not being protected.

If you were just moving value to the LeftSubject sheet then your sheets would get re-protected. Your problem comes when you are retrieving value back from that sheet & I guess you would say it is a "rookie error".

Everyone has their own programming style but many programmers would say that a procedure should only have one exit point. Yours has three (red, below). When you are retrieving values from the LeftSubject sheet, the code eventually end via the underlined red line. That is, it never gets to the code lines that re=protects the sheets.

this is the code I'm now using ...

.
.

    If Intersect(Target, Range("A8:A400")) Is Nothing Then Exit Sub
    Set LS = Sheets("LeftSubject").Range("A8:A400")
    
    If Target.Interior.ColorIndex = 3 Then
        Target.Interior.ColorIndex = xlNone
        MySwitch = False
        For Each c In LS
            If c.Value = Target.Value Or MySwitch Then
                c.Value = c.Offset(1, 0).Value
                c.Offset(0, 4).Value = c.Offset(1, 4).Value
                MySwitch = True
            End If
            If c.Value = "" Then Exit Sub
        Next c
    Else
        Target.Interior.ColorIndex = 3
        Set c = LS.Offset(-1).Find("")
        c.Value = Target.Value
        c.Offset(0, 4) = Now
    End If
    
    ActiveSheet.Protect Password:="Malibu00"
    Sheets("LeftSubject").Select
    ActiveSheet.Protect Password:="Malibu00"
    Sheets("Entry").Select
    Range("A7").Select

End Sub

I mentioned previously that there is a more direct way to find and remove a value from "LeftSubject" than looping right from the top to the bottom.

Here is an alternative code that you might try (in a copy of your workbook). It incorporates the idea on just one exit point for the code (End Sub) as well as the non-looping removal from LeftSubject. Give it a try and see if it does what you want.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim wsLS As Worksheet
  Dim NextCell As Range, Found As Range
  
  If Not Intersect(Target, Range("A8:A400")) Is Nothing Then
    ActiveSheet.Unprotect Password:="Malibu00"
    Set wsLS = Sheets("LeftSubject")
    wsLS.Unprotect Password:="Malibu00"
    If Target.Interior.ColorIndex = 3 Then
      Target.Interior.ColorIndex = xlNone
      Set Found = wsLS.Columns("A").Find(What:=Target.Value, LookAt:=xlWhole)
      If Not Found Is Nothing Then Found.Resize(, 5).Delete Shift:=xlUp
    Else
      Target.Interior.ColorIndex = 3
      Set NextCell = wsLS.Cells(wsLS.Rows.Count, "A").End(xlUp).Offset(1)
      NextCell.Value = Target.Value
      NextCell.Offset(0, 4) = Now
    End If
    ActiveSheet.Protect Password:="Malibu00"
    wsLS.Protect Password:="Malibu00"
  End If
End Sub

BTW, what is the cell formatting in column E of 'LeftSubject'?

 

[palaeontology]

Hi again Peter,

your code definitely works, and thankyou so very much for that. I really do appreciate it.

However, even using your code, I'm still getting the pop-up message saying ... "The cell or chart you're trying to change is on a protected sheet. To make changes, click Unprotect Sheet in the Review tab (you might need a password)."

Is there any way to avoid having that message coming up when double clicking in the range A8:A400 on this sheet. I still need that message to appear if the user tries to enter the other protected cells on that sheet though.

If nothing can be done, no problem, I can simply educate the users to ignore it, but I hate leaving loose ends like that.

Kind regards,

Chris

 

[Peter_SSs]

However, even using your code, I'm still getting the pop-up message saying ... "The cell or chart you're trying to change is on a protected sheet. ..

1. Do you have any other code in the workbook? For example, is there some Worksheet_Change code in either sheet? My suspicion is that you have some other code that is re-protecting one or both sheets after my code unprotects it/them but before my code has finished working with the sheet(s).

2. When you get the error message, click Debug & report exactly what text in the code is highlighted.