Unlock row based on location of active cell?

[EssKayKay]

I ran into another problem. Is it possible to “unlock” all cells in a row when the active (highlighted) cell is in Range M32:M700. That is, if the active cell is M77, then all of Row 77 would be unlocked. However, if the active cell is not in Range M32:M700 then the entire range of B32:L700 would be locked.

I’m not positive this will do what I want as there are numerous other conditions taking place. I’d like to start with this and see what happens.

Thanks,
Steve K.

 

[Jeffrey Mahoney]

I don't know how this is going to work for you. If you unlock the row only if you're in column M, then as soon as you move your cursor, you won't be in column M and will lock the entire range

I created two named ranges. WatchRange which includes M32:M700 and LockRange which includes B32:L700

I wrote this macro which needs to be put in the SHEET module section of VBA for the sheet you want to have this work. This does what you ask, but you're not going to be able to edit any cells. I would just make the WatchRange and the LockRange the same. Any time you cursor within the LockRange, the macro would unlock the current row. IF you want that just change the bold text to LockRange.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim Sht As Worksheet
  Dim R As Range
  
  If Not Intersect(Target, Range("[B]WatchRange[/B]")) Is Nothing Then
    Set Sht = ActiveSheet
    Sht.Unprotect
    Range("LockRange").Locked = True
    Set R = Intersect(Range("LockRange"), Target.EntireRow)
    If Not R Is Nothing Then R.Locked = False
    'Intersect(Range("LockRange"), Target.EntireRow).Locked False
    Sht.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
  Else
    Set Sht = ActiveSheet
    Sht.Unprotect
    Range("LockRange").Locked = True
    Sht.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
  End If
    
End Sub

 

[EssKayKay]

I don't know how this is going to work for you. If you unlock the row only if you're in column M, then as soon as you move your cursor, you won't be in column M and will lock the entire range

I created two named ranges. WatchRange which includes M32:M700 and LockRange which includes B32:L700

I wrote this macro which needs to be put in the SHEET module section of VBA for the sheet you want to have this work. This does what you ask, but you're not going to be able to edit any cells. I would just make the WatchRange and the LockRange the same. Any time you cursor within the LockRange, the macro would unlock the current row. IF you want that just change the bold text to LockRange.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim Sht As Worksheet
  Dim R As Range
 
  If Not Intersect(Target, Range("[B]WatchRange[/B]")) Is Nothing Then
    Set Sht = ActiveSheet
    Sht.Unprotect
    Range("LockRange").Locked = True
    Set R = Intersect(Range("LockRange"), Target.EntireRow)
    If Not R Is Nothing Then R.Locked = False
    'Intersect(Range("LockRange"), Target.EntireRow).Locked False
    Sht.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
  Else
    Set Sht = ActiveSheet
    Sht.Unprotect
    Range("LockRange").Locked = True
    Sht.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
  End If
   
End Sub

Thank you Jeffrey. I will play with this a bit and see how it works. I'm not the most proficient VBA guy so please bear with me. I'll keep you posted.

 

[Jeffrey Mahoney]

looks like the site tool added some extra characters. You need to remove the and out of the code
If Not Intersect(Target, Range("WatchRange")) Is Nothing Then

So if you did change the code it would look like this
If Not Intersect(Target, Range("LockRange")) Is Nothing Then

 

[EssKayKay]

Well Jeffrey I tried entering your code into my existing Private Sub Worksheet_SelectionChange(ByVal Target As Range. However, no matter where I placed it I received an error:

Run Time error 1004: Method range of object ‘_Worksheet’ failed.
I have other items noted in the subroutine. Please realize by no means am I a programmer so I assume there is some goofy coding in this.

Following is my Private Sub Worksheet_SelectionChange(ByVal Target As Range) sub. I realize this will probably not make much sense as I noted I am not a programmer - but for the most part, it does what I want:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Range("I33").Locked = True Then
If Intersect(Target, Range("M:M")) Is Nothing Then Exit Sub
If Not Intersect(ActiveCell, Range("M33:M633")) Is Nothing Then
If Range("M32").Locked Then
MsgBox " Select the PAYM'T MADE button" & vbNewLine & _
" above to enter payment date or" & vbNewLine & " select Title Bar to return Home."
Range("N32").Select
GoTo Continue
End If
End If
End If

If Intersect(Target, Range("M:M,I:I")) Is Nothing Then Exit Sub
If Not Intersect(ActiveCell, Range("M33:M633")) Is Nothing Then
If Range("M32").Locked Then
MsgBox " Select the PAYM'T MADE button" & vbNewLine & _
" above to enter payment date or" & vbNewLine & " select Title Bar to return Home."
Range("N32").Select
GoTo Continue
End If
End If

If Not Intersect(Target, Range("M32:M1300,I32:I1300")) Is Nothing Then
Now = (Split(ActiveCell(1).Address(1, 0), "$")(1))
If (Old <> Now) Then
UnProtect_It
Range(Cells(Now, 3), Cells(Now, 3)).Font.Color = vbRed
If Old Then Range(Cells(Old, 3), Cells(Old, 3)).Font.Color = False
Range(Cells(Now, 3), Cells(Now, 3)).Font.Bold = True
If Old Then Range(Cells(Old, 3), Cells(Old, 3)).Font.Bold = False
Protect_It
End If
Old = Now
End If
'- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

If Target.Cells.CountLarge = 1 And Not Intersect(Range("M32:M632"), Target) Is Nothing Then
On Error GoTo Escape
Application.EnableEvents = False


'SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS
If ActiveCell.Offset(-1, 0) <= 0 Then

If MsgBox(" --- WARNING ---" _
& vbNewLine & vbNewLine & " Do not skip a Payment." & vbNewLine & _
" ~~~~~~~~~~~~~~~~~~~~" & vbNewLine & _
" It is assumed all payments are made in" & vbNewLine & " full, on time, and posted consecutively." & vbNewLine & _
" Partial or skipped payments will cause" & vbNewLine & " an inaccurate Amortization Schedule.") = vbOK Then
NextPayDate
Else
End If
End If

'----- Copy/Paste Values when date is entered in Column M ------
If IsDate(Target.Value) Then
With Target.Offset(, -11).Resize(, 10)
.Value = .Value
End With
End If

'If IsDate(Target) Then Target.Offset(, -2).Value = Target.Offset(, -2).Value 'Updates only one column
'SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS

End If


Continue:
Application.EnableEvents = True
Exit Sub
Escape:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume Continue

End Sub

I think for now I will just accept the error that appears stating the cells that are to be updated (copy paste special formulas to values). I may look at this a bit more but I do believe this may be beyond my pay grade. I do thank you for your concern and suggestions.

Again, much appreciated - I do sincerely appreciate you comments,
Steve K.

 

[EssKayKay]

Please disregard the previous post. I think I found something else. I tried to delete the post but apparently that's not an option.