Unlock cell based on location of active cell

EssKayKay

Active Member
Joined
Jan 5, 2003
Messages
417
Office Version
  1. 2007
Platform
  1. Windows
I’m not sure I want to do this but I’d like to try it. I am looking for some VBA routine that unprotects a cell based on the location of the active cell.

All cells in Column H are locked. If the active cell is in column M, I want the corresponding row/cell in Column H to become “unlocked”. If I move the active cell to some other column other than M then all cells in column H again become locked.

Example: if the active cell is M44, then I want H44 to become “unlocked”. If I cursor down to cell M45, then H44 becomes locked and H45 becomes unlocked. If the active cell is B3 then all cells in column H remain locked.
 
One thing at a time. As far as this goes:
My concern right now is the error that pops up when a populated cell in column M is highlighted.
I simply moved one of your UnProtect_It lines to a different place in your Sub Worksheet_SelectionChange module. So that part should be fixed when you make it look like this:
Rich (BB code):
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

   If Not Intersect(Target, Range("M32:M1300,I32:I1300")) Is Nothing Then
      UnProtect_It                  '<-- ***** move this line to here ****
      Now = (Split(ActiveCell(1).Address(1, 0), "$")(1))
          If (Old <> Now) Then
             UnProtect_It
             Range(Cells(Now, 3), Cells(Now, 3)).Font.Bold = True
             If Old Then Range(Cells(Old, 3), Cells(Old, 3)).Font.Bold = False

             Range(Cells(Now, 3), Cells(Now, 3)).Font.Color = vbRed
             If Old Then Range(Cells(Old, 3), Cells(Old, 3)).Font.Color = False
             Protect_It
          End If
       Old = Now
   End If
 
Upvote 0

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
Try this..

WARNING: CANNOT UNDO CHANGES. TEST ON A COPY OF YOUR WORKBOOK

VBA Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    ' Check if the active cell is in column M
    If Not Intersect(Target, Me.Range("M:M")) Is Nothing Then
        ' Unprotect the sheet
        Me.Unprotect

 

        ' Check if the previous active cell was in column H
        If Not Intersect(Me.Cells(1, "H"), Me.Cells(1, Target.Column - 1)) Is Nothing Then
            ' Lock the previous active cell in column H
            Me.Cells(Target.Row, "H").locked = True
        End If

 

        ' Get the corresponding cell in column H for the active row
        Dim CorrespondingCell As Range
        Set CorrespondingCell = Me.Cells(Target.Row, "H")

 

        ' Unlock the corresponding cell in column H
        CorrespondingCell.locked = False
    End If
End Sub

 

Private Sub Worksheet_Change(ByVal Target As Range)
    ' Protect the sheet after editing
    Me.Protect
End Sub
 
Upvote 0
One thing at a time. As far as this goes:

I simply moved one of your UnProtect_It lines to a different place in your Sub Worksheet_SelectionChange module. So that part should be fixed when you make it look like this:
Rich (BB code):
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

   If Not Intersect(Target, Range("M32:M1300,I32:I1300")) Is Nothing Then
      UnProtect_It                  '<-- ***** move this line to here ****
      Now = (Split(ActiveCell(1).Address(1, 0), "$")(1))
          If (Old <> Now) Then
             UnProtect_It
             Range(Cells(Now, 3), Cells(Now, 3)).Font.Bold = True
             If Old Then Range(Cells(Old, 3), Cells(Old, 3)).Font.Bold = False

             Range(Cells(Now, 3), Cells(Now, 3)).Font.Color = vbRed
             If Old Then Range(Cells(Old, 3), Cells(Old, 3)).Font.Color = False
             Protect_It
          End If
       Old = Now
   End If

I added the UnProtect_It to the recommended location. However, I still get the error message when I arrow up the column M when the active cell is in a populated cell. I'll look closer at this tommorrow.

Again, much appreciated.
 
Upvote 0
Try this..

WARNING: CANNOT UNDO CHANGES. TEST ON A COPY OF YOUR WORKBOOK

VBA Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    ' Check if the active cell is in column M
    If Not Intersect(Target, Me.Range("M:M")) Is Nothing Then
        ' Unprotect the sheet
        Me.Unprotect

 

        ' Check if the previous active cell was in column H
        If Not Intersect(Me.Cells(1, "H"), Me.Cells(1, Target.Column - 1)) Is Nothing Then
            ' Lock the previous active cell in column H
            Me.Cells(Target.Row, "H").locked = True
        End If

 

        ' Get the corresponding cell in column H for the active row
        Dim CorrespondingCell As Range
        Set CorrespondingCell = Me.Cells(Target.Row, "H")

 

        ' Unlock the corresponding cell in column H
        CorrespondingCell.locked = False
    End If
End Sub

 

Private Sub Worksheet_Change(ByVal Target As Range)
    ' Protect the sheet after editing
    Me.Protect
End Sub

Thank you BigBeach for your suggestions. I'll have to look at this tomorrow. I'll keep you posted.
 
Upvote 0
Try this..

WARNING: CANNOT UNDO CHANGES. TEST ON A COPY OF YOUR WORKBOOK

VBA Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    ' Check if the active cell is in column M
    If Not Intersect(Target, Me.Range("M:M")) Is Nothing Then
        ' Unprotect the sheet
        Me.Unprotect

 

        ' Check if the previous active cell was in column H
        If Not Intersect(Me.Cells(1, "H"), Me.Cells(1, Target.Column - 1)) Is Nothing Then
            ' Lock the previous active cell in column H
            Me.Cells(Target.Row, "H").locked = True
        End If

 

        ' Get the corresponding cell in column H for the active row
        Dim CorrespondingCell As Range
        Set CorrespondingCell = Me.Cells(Target.Row, "H")

 

        ' Unlock the corresponding cell in column H
        CorrespondingCell.locked = False
    End If
End Sub

 

Private Sub Worksheet_Change(ByVal Target As Range)
    ' Protect the sheet after editing
    Me.Protect
End Sub

Thanks BBB for your suggestion. I inserted your code into my spreadsheet as suggested. However, I still receive the "Error 1004 – the cell or chart you are trying to change is protected and therefore read-only. . . ." when I arrow/cursor up column M from an empty cell to one that is populated. That is, any time I highlight a cell in Column M with a date in it the error pops up.

Again, appreciated.
Steve
 
Upvote 0
Not to muddy the waters here too much but what if I (read we) looked at this in the opposite way. I’m not sure this is even possible but why not have Column H always “unlocked” unless the active cell is in column H. If the active cell is in column H then run a routine that “locks” column H.

Thanks again,
 
Upvote 0
I added the UnProtect_It to the recommended location. However, I still get the error message when I arrow up the column M when the active cell is in a populated cell. I'll look closer at this tommorrow.

Again, much appreciated.
Unfortunately Steve, I cannot duplicate the problem you're having. I made the change in the code I said in post #11 and I can select, or move within column M without any error messages presenting. Link to the amended file below:
 
Upvote 0
Thanks BBB for your suggestion. I inserted your code into my spreadsheet as suggested. However, I still receive the "Error 1004 – the cell or chart you are trying to change is protected and therefore read-only. . . ." when I arrow/cursor up column M from an empty cell to one that is populated. That is, any time I highlight a cell in Column M with a date in it the error pops up.

Again, appreciated.
Steve
I'm with kevin9999 here.
I don't have any issue with my code arrowing up and down column M.
Did you select a cell in M and immediately go to H? You cannot use the arrow over because it triggers based on the last active cell. You must use your mouse cursor and click.
 
Upvote 0
Unfortunately Steve, I cannot duplicate the problem you're having. I made the change in the code I said in post #11 and I can select, or move within column M without any error messages presenting. Link to the amended file below:

Unfortunately Steve, I cannot duplicate the problem you're having. I made the change in the code I said in post #11 and I can select, or move within column M without any error messages presenting. Link to the amended file below:
Here is a video showing the error.

I'm going to keep working on this a bit more but I'm probably about to call it over.
 
Upvote 0
I'm with kevin9999 here.
I don't have any issue with my code arrowing up and down column M.
Did you select a cell in M and immediately go to H? You cannot use the arrow over because it triggers based on the last active cell. You must use your mouse cursor and click.
Here is a video showing the error.

I'm going to keep working on this a bit more but I'm probably about to call it over.
 
Upvote 0

Forum statistics

Threads
1,224,835
Messages
6,181,245
Members
453,026
Latest member
cknader

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top