Locking and unlocking cells

montecarlo2079

Board Regular
Joined
Feb 9, 2011
Messages
207
I have a form that calculates a score of an individual.

There is one section that a person can earn a score on one section or the other.

So if there is a score in cell A1, then I should not be allowed to enter anything in cell B1.

And Vice Versa

I found this but it only works one way

Code:
Private Sub Worksheet_Change(ByVal Target As Range) 
    If InRange(ActiveCell, Range("A1")) Then 
        ActiveSheet.Unprotect 
        ActiveCell.Offset(-1, 0).Locked = True 
        ActiveSheet.Protect 
    Else: End If 
    End Sub


Function InRange(Range1 As Range, Range2 As Range) As Boolean 
     'returns True if Range1 is within Range2
    Dim InterSectRange As Range 
    Set InterSectRange = Application.Intersect(Range1, Range2) 
    InRange = Not InterSectRange Is Nothing 
    Set InterSectRange = Nothing 
End Function

This doesnt seem to work.

Any suggestions?
 

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.

VoG

Legend
Joined
Jun 19, 2002
Messages
63,650
Try

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Select Case Target.Address(False, False)
    Case "A1"
        Me.Unprotect
        Target.Offset(, 1).Locked = True
        Me.Protect
    Case "B1"
        Me.Unprotect
        Target.Offset(, -1).Locked = True
        Me.Protect
End Select
End Sub
 

montecarlo2079

Board Regular
Joined
Feb 9, 2011
Messages
207
it doesnt work, it allows me to enter values in one, the other or both.

I can only have one value in either a1 or b1, but not both
 

VoG

Legend
Joined
Jun 19, 2002
Messages
63,650
It works perfectly here. Where did you put the code - you need to right click the sheet tab, select View Code and paste in the code.

As presently coded it applies only to A1 and B1, not the whole of those columns. That could easily be changed.
 

montecarlo2079

Board Regular
Joined
Feb 9, 2011
Messages
207
I think I got it
Private Sub Worksheet_Change(ByVal Target As Range)
If Range("f24") > 0 And Range("f26") > 0 Then
MsgBox "ONLY ONE SCORE IS ALLOWED FOR THIS SECTION"
Range("f24").Select
Selection.ClearContents
Range("f26").Select
Selection.ClearContents
Range("f24").Select
End If
If Range("f26") > 0 And Range("f24") > 0 Then
MsgBox "ONLY ONE SCORE IS ALLOWED FOR THIS SECTION"
Range("f24").Select
Selection.ClearContents
Range("f26").Select
Selection.ClearContents
Range("f24").Select
End If

End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,130,119
Messages
5,640,218
Members
417,131
Latest member
Seanr19871

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
Top