How to uncheck Select Locked Cells & check AllowHyperlinks & AllowAutofilters in VBA code

[Harls]

Hello All

I am extremely new to VBA code & would very much appreciate a little help

I have set up a worksheet which has a macro for checkboxes & also some code to hide various autofilter arrows. This all works fine until I manually Protect the worksheet. I want to protect the sheet so users can not select locked cells, but can insert Hyperlinks & use Autofilters. With Protection on I get runtime error 1004 when using the check boxes. I have since changed the macro to unprotect & then protect after running, which gets rid of the runtime error but now I can select locked cells & I cant insert Hyperlinks or use the autofilter. I understand that when it is protecting itselg again after running the macro it is "standard" protection setting that are being applied & I therefore need to uncheck the Select Locked Cells & Check The AllowHyperlinks & AllowAutofilters, But I am struggling to get it right.

Any Ideas

Many Thanks in advance

P.S. Please see below my macro & code as it stands

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Sheet1.Unprotect Password:=3581
If (ActiveCell.Column = 22 Or ActiveCell.Column = 25 Or ActiveCell.Column = 28 Or ActiveCell.Column = 35 Or ActiveCell.Column = 40 Or ActiveCell.Column = 43 Or ActiveCell.Column = 47) And _
ActiveCell.Row > 23 Then
If ActiveCell.Value = "P" Then
ActiveCell.Value = ""
Else
ActiveCell.Value = "P"
ActiveCell.Font.Name = "Wingdings 2"
End If
ActiveCell.Offset(0, 1).Select
End If
Sheet1.Protect Password:=3581
End Sub
Sub HideArrowsRange()
Dim c As Range
Dim i As Integer
Dim rng As Range
Set rng = Range("B22:AW22")
i = rng.Cells(1, 1).Column - 1
Application.ScreenUpdating = False

For Each c In Range("B22:AW22")
Select Case c.Address
Case "$B$22", "$C$22", "$D$22", "$F$22", "$G$22", "$H$22", "$I$22", "$J$22", "$K$22", "$L$22", "$M$22", "$N$22", "$P$22", "$R$22", "$T$22", "$U$22", "$W$22", "$X$22", "$Z$22", "$AA$22", "$AC$22", "$AD$22", "$AE$22", "$AF$22", "$AG$22", "$AH$22", "$AJ$22", "$AK$22", "$AL$22", "$AM$22", "$AO$22", "$AP$22", "$AR$22", "$AS$22", "$AT$22", "$AV$22"
c.AutoFilter Field:=c.Column - i, _
Visibledropdown:=False
Case Else
c.AutoFilter Field:=c.Column - i, _
Visibledropdown:=True
End Select
Next

Application.ScreenUpdating = True
Sheet1.Protect Password:=3581
End Sub

[ajryan88]

Hi,

All you need to do is change the line

Sheet1.Protect Password:=3581

to

Sheet1.Protect Password:=3581, AllowInsertingHyperlinks:=True, AllowFiltering:=True
Sheet1.EnableSelection = xlUnlockedCells

Please note, I haven't tested this solution with your code, but it runs fine in a test spreadsheet that I just made, so let me know if this works for you

NB: By allowing filtering, you are allowing users to use a filter that was applied prior to the worksheet being protected. You cannot create or remove an autofilter once the worksheet has been protected.

[Harls]

Thank you so much ajryan88, That works great, I thought it was something along those lines. I am finding though, that when I save & close, & then re-open the workbook, I am initially able to select the locked cells (allthough they are still protected) until I either use any one of the checkboxes or in-fact double click anywhere on the sheet. This isn't the end of the world because they are still protected but it would be nice to know why & correct if possible.

Many Thanks again for responding to my question, it's nice to know there are people out there that will help others in need

[ajryan88]

Hi.

You're very welcome, I'm glad I could help.

That is weird behaviour, and I have no idea why that is happening, but to overcome it I would suggest placing 3 lines of code in the ThisWorkbook module, inside the Workbook_Open subroutine:

Sheet1.Unprotect Password:=3581
Sheet1.Protect Password:=3581, AllowInsertingHyperlinks:=True, AllowFiltering:=True
Sheet1.EnableSelection = xlUnlockedCells

See if this works for you and let me know.
Also, please don't forget to mark this thread as solved and add to my reputation when you are satisfied with the outcome

[Harls]

Spot on ajryan88, Thanks again, it works a treat

Ok will do, thanks for the tip

[ajryan88]

You're welcome

[Harls]

Hello ajryan88.

I am currently modifying the enquiry register you helped me with previously & wondered if you might be able to help again.

The enquiry register has many columns/rows, but I would like to create a data entry form to input data in a range of columns/rows (names, contact details etc): D24:Q5023. The column titles are in row 23, ie. D23:Q23 & all the rows are already numbered in column C, ie. C24:C5023. Is it possible to create a data entry form using VBA, that automatically generates when a user selects any of the cells within the specified range: D24:Q5023, with the column titles as the fields. I would also like to be able to search for data within the form, if possible including the No. (column C) within the search. If this is possible, I would then like to hide some of the columns within that range, but still be able to input the data to be held within those columns on the data entry form. The VBA currently on the sheet is as follows:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Sheet1.Unprotect Password:=3581
    If (ActiveCell.Column = 28 Or ActiveCell.Column = 31 Or ActiveCell.Column = 34 Or ActiveCell.Column = 39 Or ActiveCell.Column = 44 Or ActiveCell.Column = 47 Or ActiveCell.Column = 51) And _
       ActiveCell.Row > 25 Then
    If ActiveCell.Value = "P" Then
      ActiveCell.Value = ""
    Else
      ActiveCell.Value = "P"
      ActiveCell.Font.Name = "Wingdings 2"
    End If
    ActiveCell.Offset(0, 1).Select
  End If
  Sheet1.Protect Password:=3581, AllowInsertingHyperlinks:=True, AllowFiltering:=True
Sheet1.EnableSelection = xlUnlockedCells
End Sub
Sub HideArrowsRange()
Dim c As Range
Dim i As Integer
Dim rng As Range
Set rng = Range("B25:BA25")
i = rng.Cells(1, 1).Column - 1
Application.ScreenUpdating = False

For Each c In Range("B25:BA25")
    Select Case c.Address
    Case "$B$25", "$C$25", "$D$25", "$G$25", "$H$25", "$I$25", "$J$25", "$K$25", "$L$25", "$M$25", "$N$25", "$O$25", "$P$25", "$Q$25", "$R$25", "$S$25", "$U$25", "$W$25", "$Z$25", "$Y$25", "$AA$25", "$AC$25", "$AD$25", "$AF$25", "$AG$25", "$AI$25", "$AJ$25", "$AK$25", "$AL$25", "$AN$25", "$AO$25", "$AP$25", "$AQ$25", "$AS$25", "$AT$25", "$AV$25", "$AW$25", "$AX$25", "$AZ$25"
        c.AutoFilter Field:=c.Column - i, _
          Visibledropdown:=False
    Case Else
        c.AutoFilter Field:=c.Column - i, _
          Visibledropdown:=True
    End Select
Next

Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, [AH26:AH5025]) Is Nothing Then
        Range("AJ" & Target.Row).Value = Date
End If
End Sub

Any help would be greatly appreciated

Many Thanks in advance