# Lock cell with Hyperlinks



## barcas84 (Nov 2, 2010)

Hi, I have some cells with Index of Hyperlinks, is there anyway to lock it, so people don't delete the formula, but they can still click in the Hyperlink?

This is what I have:

=HYPERLINK(INDEX(Sheet10!A2:G98,Sheet10!J1,5),Sheet10!J3)

Thanks!


----------



## RSpecianjr (Jan 20, 2010)

Hey Marco,

You can protect the worksheet. If you have the cell protection set to locked and protect the worksheet, they cannot change the formula without a password, but can still click on the link.

If right click the cell or select a range and right click, then go to Format Cells. The last tab should be Protection, this will give you two choices, Locked and Hidden. Locked is likely already selected. Good.

Next step is to protect the worksheet. Right click on the worksheet tab at the bottom and click Protect Sheet. It will prompt you for some input with a bunch of choices on how you want to lock it. Choose what you would like, the default will work. Set your password, hit Okay, confirm your password. Done!

Hope this helps,

Robert D. Specian Jr.


----------



## barcas84 (Nov 2, 2010)

Hi Robert!

The thing is that, that doesn't work. I don't know why, but if the cell is locked and I protect the Sheet, it doesn't let me click on the hyperlink....


----------



## macropod (Apr 11, 2008)

hi Marco,

You could use code like the following in the relevant worksheet module:

```
Option Explicit
Dim bHLink As Boolean

Private Sub Worksheet_Change(ByVal Target As Range)
If bHLink = False Then Exit Sub
With Application
  .EnableEvents = False
  MsgBox "You can't alter this cell.", vbExclamation + vbOKOnly
  .Undo
  .EnableEvents = True
End With
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
bHLink = False
If InStr(Target.Formula, "HYPERLINK") > 0 Then bHLink = True
End Sub
```
With this code, you don't need to protect the sheet.


----------



## barcas84 (Nov 2, 2010)

Do I have to click in any button to run that macro? Or can it be active since the moment you open the book?


----------



## macropod (Apr 11, 2008)

Hi Marco,

You put the macros into the worksheet module for the worksheet containing the hyperlink formulae. They run automatically and monitor any attempt to change the hyperlink formulae.


----------



## barcas84 (Nov 2, 2010)

Hi, thanks for your help!

The problem I have now is that if I try to change the hyperlink, the first time it doesn't let me and it shows the message, but the second one, the code comes out with an error that seems to be in this part:

If InStr(Target.Formula, "HYPERLINK") > 0 Then bHLink = True

Or at least it's what gets in yellow...


----------



## macropod (Apr 11, 2008)

Hi Marco,

Perhaps you could explain in more detail what you're doing to produce the error, and what the error message says. So far, I am unable to reproduce this behaviour.


----------



## barcas84 (Nov 2, 2010)

Hi, yeah sure. 

After saving the macro, I went and try to overwrite a cell with a hyperlink, and it didn't let me, it said, this cell can't be alter. But then, I tried to delete the content of the cell and it came up with an error: Run time Error'13' Type mismatch.

Now, from the first time, after showing the "You can't alter this cell" the error comes up. If I click debug, it highlights the line: If InStr(Target.Formula, "HYPERLINK") > 0 Then bHLink = True

Hope that helps!!!

Thanks!!!


----------



## macropod (Apr 11, 2008)

Hi Marco,

The only way I can generate such an error is by trying to edit multiple cells simultaneously (eg deleting the row containing the cell). Try the following version of the code:

```
Option Explicit
Dim bHLink As Boolean, strAdd As String

Private Sub Worksheet_Change(ByVal Target As Range)
If bHLink = False Then Exit Sub
With Application
  .EnableEvents = False
  .Undo
  MsgBox "You can't alter cell(s):" & vbCr & strAdd, vbExclamation + vbOKOnly
  .EnableEvents = True
End With
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim ocel As Range
bHLink = False
strAdd = ""
On Error Resume Next
For Each ocel In Intersect(Target.Cells, UsedRange.Cells)
  If InStr(ocel.Formula, "HYPERLINK") > 0 Then
    bHLink = True
    strAdd = strAdd & ocel.Address & vbCr
  End If
Next
End Sub
```


----------



## macropod (Apr 11, 2008)

Oops! Change the 'Worksheet_SelectionChange' sub to:

```
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim ocel As Range
bHLink = False
strAdd = ""
For Each ocel In Selection
  If InStr(ocel.Formula, "HYPERLINK") > 0 Then
    bHLink = True
    strAdd = strAdd & vbCr & ocel.Address
  End If
Next
End Sub
```
*Note:* If you select a whole column to process, there may be a noticeable delay before the macro responds.


----------



## barcas84 (Nov 2, 2010)

Now is working perfect!!!! Thank you paul!!


----------

