Thanks Thanks:  0
Likes Likes:  0
Page 1 of 2 12 LastLast
Results 1 to 10 of 19

Thread: A small adjustment needed to an existing code

  1. #1
    Board Regular
    Join Date
    May 2017
    Posts
    147
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default A small adjustment needed to an existing code

    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.

    Code:
    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

  2. #2
    MrExcel MVP
    Moderator
    Peter_SSs's Avatar
    Join Date
    May 2005
    Location
    Macksville, Australia
    Posts
    34,406
    Post Thanks / Like
    Mentioned
    3 Post(s)
    Tagged
    1 Thread(s)

    Default Re: A small adjustment needed to an existing code

    Quote Originally Posted by palaeontology View Post
    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
    Code:
    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.
    Hope this helps, good luck.
    Peter
    Excel 365 + Excel 2010, 2007, 2003 - Windows 10, 7
    - Want to help your helpers by posting a small, copyable, screen shot directly in your post? Look here
    - If posting vba code, please use Code Tags - like this [code]Paste code here[/code] - or use the VBHTML Maker
    - Read: Forum Rules & Forum Use Guidelines

  3. #3
    Board Regular
    Join Date
    May 2017
    Posts
    147
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: A small adjustment needed to an existing code

    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 ?

    Code:
    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
    Last edited by palaeontology; Aug 8th, 2017 at 08:18 AM.

  4. #4
    MrExcel MVP
    Moderator
    Peter_SSs's Avatar
    Join Date
    May 2005
    Location
    Macksville, Australia
    Posts
    34,406
    Post Thanks / Like
    Mentioned
    3 Post(s)
    Tagged
    1 Thread(s)

    Default Re: A small adjustment needed to an existing code

    You still have to provide the password for Unprotecting/Protecting
    Code:
    ActiveSheet.Unprotect Password:="Malibu00"
    
    ' Other code
    
    ActiveSheet.Protect Password:="Malibu00"
    Hope this helps, good luck.
    Peter
    Excel 365 + Excel 2010, 2007, 2003 - Windows 10, 7
    - Want to help your helpers by posting a small, copyable, screen shot directly in your post? Look here
    - If posting vba code, please use Code Tags - like this [code]Paste code here[/code] - or use the VBHTML Maker
    - Read: Forum Rules & Forum Use Guidelines

  5. #5
    Board Regular
    Join Date
    May 2017
    Posts
    147
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: A small adjustment needed to an existing code

    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
    Last edited by palaeontology; Aug 8th, 2017 at 01:44 PM.

  6. #6
    MrExcel MVP
    Moderator
    Peter_SSs's Avatar
    Join Date
    May 2005
    Location
    Macksville, Australia
    Posts
    34,406
    Post Thanks / Like
    Mentioned
    3 Post(s)
    Tagged
    1 Thread(s)

    Default Re: A small adjustment needed to an existing code

    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.
    Hope this helps, good luck.
    Peter
    Excel 365 + Excel 2010, 2007, 2003 - Windows 10, 7
    - Want to help your helpers by posting a small, copyable, screen shot directly in your post? Look here
    - If posting vba code, please use Code Tags - like this [code]Paste code here[/code] - or use the VBHTML Maker
    - Read: Forum Rules & Forum Use Guidelines

  7. #7
    Board Regular
    Join Date
    May 2017
    Posts
    147
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: A small adjustment needed to an existing code

    Hi again Peter,

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

    Code:
    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 ...

    Code:
    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 ?

    Code:
    DrawingObjects:=True, Contents:=True, Scenarios:=True
    Kind regards,

    Chris
    Last edited by palaeontology; Aug 10th, 2017 at 05:01 PM.

  8. #8
    MrExcel MVP
    Moderator
    Peter_SSs's Avatar
    Join Date
    May 2005
    Location
    Macksville, Australia
    Posts
    34,406
    Post Thanks / Like
    Mentioned
    3 Post(s)
    Tagged
    1 Thread(s)

    Default Re: A small adjustment needed to an existing code

    Quote Originally Posted by palaeontology View Post
    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.

    Quote Originally Posted by palaeontology View Post
    this is the code I'm now using ...

    Code:
    .
    .
    
        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.

    Code:
    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'?
    Hope this helps, good luck.
    Peter
    Excel 365 + Excel 2010, 2007, 2003 - Windows 10, 7
    - Want to help your helpers by posting a small, copyable, screen shot directly in your post? Look here
    - If posting vba code, please use Code Tags - like this [code]Paste code here[/code] - or use the VBHTML Maker
    - Read: Forum Rules & Forum Use Guidelines

  9. #9
    Board Regular
    Join Date
    May 2017
    Posts
    147
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: A small adjustment needed to an existing code

    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

  10. #10
    MrExcel MVP
    Moderator
    Peter_SSs's Avatar
    Join Date
    May 2005
    Location
    Macksville, Australia
    Posts
    34,406
    Post Thanks / Like
    Mentioned
    3 Post(s)
    Tagged
    1 Thread(s)

    Default Re: A small adjustment needed to an existing code

    Quote Originally Posted by palaeontology View Post
    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.
    Hope this helps, good luck.
    Peter
    Excel 365 + Excel 2010, 2007, 2003 - Windows 10, 7
    - Want to help your helpers by posting a small, copyable, screen shot directly in your post? Look here
    - If posting vba code, please use Code Tags - like this [code]Paste code here[/code] - or use the VBHTML Maker
    - Read: Forum Rules & Forum Use Guidelines

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
This website uses cookies
We use cookies to store session information to facilitate remembering your login information, to allow you to save website preferences, to personalise content and ads, to provide social media features and to analyse our traffic. We also share information about your use of our site with our social media, advertising and analytics partners.
     


DMCA.com