how to make cell read only

[ndalal]

Hi,

I have tried the following code, but doesn't work unless I protect the
sheet:
Range("A1:A4").Select
Selection.Locked = True
Selection.FormulaHidden = False

If I protect the sheet, then it works fine, but how can I make a cell
read only
WITHOUT protecting the sheet ??

Any help is appreciated.

Thanks.

 

[Harald Staff]

You can't, sorry.

Best wishes Harald

 

[Ikaabod]

Technically you can't, but depending on your needs you can do something
as follows, where "F7" is the cell you want protected:

Private Sub Worksheet_Change(ByVal Target As Range)
Range("F7").Value = "Your Formula or Text Goes Here"
End Sub

 

[Ikaabod]

Also, if you're trying to prevent people from knowing what formula
you're using I would suggest having the macro calculate the formula
(instead of having the formula in the cell) and just put a value in the
cell and then you can lock your macro.

 

[Ken Johnson]

Hi,
You could use a Worksheet_Change Sub to kick the user out of A1:A4
should they ever try to click into any of those four cells.

If that would do then just paste this into that worksheet's code
module...

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(ActiveCell, Range("A1:A4")) Is Nothing Then
Range("B1").Select
End If
End Sub

Ken Johnson

 

[Ikaabod]

This is also true, but be careful when using this method because you can
still select B4:A1 and delete/edit the contents.

 

[Ken Johnson]

Hi Ikaabod,

Good point!

How about...

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Selection, Range("A1:A4")) Is Nothing Then
Range("B1").Select
End If
End Sub

Ken Johnson

 

[ndalal]

Thanks a lot for all the good points. I will try them out today and let
you guys know.

That was great help....really appreciate it.

 

[ndalal]

Ken, do you have a way to make the whole column read only?

Ikaabod, your solution works only if the cell has fixed data, however
my data keeps changing in those cells so Ken's solution works better.

- Nirav

 

[Ikaabod]

Ken's last suggestion is probably the best. If you want the entire
column just change:
If Not Intersect(Selection, Range("A1:A4"))
to
If Not Intersect(Selection, Range("A:A"))

 

[ndalal]

OK guys, I have a bigger problem...after fixing the read only cell
issue as described by Ken, excel hangs as I have another function -
Private Sub Worksheet_Change(ByVal Target As Range)

This function is called by Worksheet_SelectionChange....why? And this
function is doing some sort of loop over 64k rows and 25 columns, which
basically hangs excel.

Please help....

The code is pasted below:

===============================================================

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Selection, Range("N55")) Is Nothing Then
Range("A5").Select
End If
End Sub

===============================================================

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Col As Integer, ColLimit As Integer, ctcol As Integer, ctrow As
Integer
Dim Row As Double, RowLimit As Double
Dim StopCol As Integer, StopRow As Integer
Dim strlc As String
Dim whichRow As Integer, whichCol As Integer

whichRow = Target.Row
whichCol = Target.Column
RowLimit = 65536 'Maximun number of rows allowed in a sheet
ColLimit = 25 'Maximun number of columns allowed in a sheet

'Find the data columns and first data row
Row = 1 'Set row counter to row 1
Col = 1 'Set column counter to
column 1
Do While Row < RowLimit
ctrow = LTrim(Str(Row)) 'Set row index loop
Do While Col < ColLimit
ctcol = LTrim(Str(Col)) 'Set column index loop
test = Cells(ctrow, ctcol).Text 'Read the value of the cell
and store into test
Select Case test 'Evaluate test to set event
area
Case "DIB"
StopCol = Col 'Set StopCol to the current
column
StartRow = Row + 1 'Set StartRow to the current
row + 1
Col = ColLimit
Row = RowLimit
Case Else
Col = Col + 1 'Increment the column
index to move to the next cell
End Select
Loop
Col = 1
Row = Row + 1
Loop

If Target.Row < StartRow Then Exit Sub
If Target.Column >= StopCol Then Exit Sub
If Target.Columns.Count >= ColLimit Then Exit Sub

'Clear the "DIB" column
StopRow = Target.Rows.Count - 1

Range(Cells(Target.Row, StopCol), Cells(Target.Row + StopRow, StopCol +
2)).ClearContents

End Sub

===============================================================

 

[ndalal]

Please ignore my previous message...it was my mistake that I didn't
have "DIB" anywhere on the sheet.....

thanks for all the help...goodluck to all.