VBA doesn't work when worksheet is protected

CBisME123

New Member
Joined
Sep 6, 2021
Messages
6
Office Version
  1. 365
Platform
  1. Windows
I have used the VBA code from this site: Excel Data Validation Combo box using Named Ranges

It allows me to increase the size (or the appearance) of the text in my drop down list. However, I'm now done putting my worksheet together and whenever I protect it the VBA no longer works.

Is there a way to do this and protect the sheet?

VBA Code:
Private Sub Worksheet_BeforeDoubleClick _
  (ByVal Target As Range, _
    Cancel As Boolean)
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Set ws = ActiveSheet

Set cboTemp = ws.OLEObjects("TempCombo")
  On Error Resume Next
  With cboTemp
  'clear and hide the combo box
    .ListFillRange = ""
    .LinkedCell = ""
    .Visible = False
  End With
On Error GoTo errHandler
  If Target.Validation.Type = 3 Then
    'if the cell contains
      'a data validation list
    Cancel = True
    Application.EnableEvents = False
    'get the data validation formula
    str = Target.Validation.Formula1
    str = Right(str, Len(str) - 1)
    With cboTemp
      'show the combobox with the list
      .Visible = True
      .Left = Target.Left
      .Top = Target.Top
      .Width = Target.Width + 5
      .Height = Target.Height + 5
      .ListFillRange = str
      .LinkedCell = Target.Address
    End With
    cboTemp.Activate
    'open the drop down list automatically
    Me.TempCombo.DropDown
  End If
 
errHandler:
  Application.EnableEvents = True
  Exit Sub

End Sub
'=========================================
Private Sub TempCombo_LostFocus()
  With Me.TempCombo
    .Top = 10
    .Left = 10
    .Width = 0
    .ListFillRange = ""
    .LinkedCell = ""
    .Visible = False
    .Value = ""
  End With
End Sub
 '====================================
'Optional code to move to next cell
'if Tab or Enter are pressed
'from code by Ted Lanham
'***NOTE: if KeyDown causes problems,
'change to KeyUp
'Table with numbers for other keys
'such as Right Arrow (39)
'[URL='https://msdn.microsoft.com/en-us/library/aa243025%28v=vs.60%29.aspx']https://msdn.microsoft.com/en-us/library/aa243025(v=vs.60).aspx[/URL]

Private Sub TempCombo_KeyDown(ByVal _
     KeyCode As MSForms.ReturnInteger, _
     ByVal Shift As Integer)
  Select Case KeyCode
    Case 9 'Tab
      ActiveCell.Offset(0, 1).Activate
    Case 13 'Enter
      ActiveCell.Offset(1, 0).Activate
    Case Else
        'do nothing
  End Select
End Sub
'====================================
 
Last edited by a moderator:

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result

JoeMo

MrExcel MVP
Joined
May 26, 2009
Messages
18,034
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
Right after the Set ws = Activesheet line add this line and your password where noted between the quote marks:
VBA Code:
ws.Protect Password:="Your pswd here", UserInterfaceOnly:=True
 
Upvote 0

sykes

Well-known Member
Joined
May 1, 2002
Messages
1,885
Office Version
  1. 365
Platform
  1. Windows
VBA Code:
Private Sub Worksheet_BeforeDoubleClick _
(ByVal Target As Range, _
Cancel As Boolean)
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Set ws = ActiveSheet
ws.unprotect Password:= "password1234"

Set cboTemp = ws.OLEObjects("TempCombo")
On Error Resume Next
With cboTemp
'clear and hide the combo box
.ListFillRange = ""
.LinkedCell = ""

Blah blah blah

ws.protect Password:= "password1234"
 
Upvote 0

CBisME123

New Member
Joined
Sep 6, 2021
Messages
6
Office Version
  1. 365
Platform
  1. Windows
Right after the Set ws = Activesheet line add this line and your password where noted between the quote marks:
VBA Code:
ws.Protect Password:="Your pswd here", UserInterfaceOnly:=True
Thanks for your help but this doesn't seem to work
 
Upvote 0

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
58,595
Office Version
  1. 365
Platform
  1. Windows
When posting vba code, please use the available code tags to preserve indentation. My signature block below has more help on that. This time I have fixed it for you in post #1.
 
Upvote 0

JoeMo

MrExcel MVP
Joined
May 26, 2009
Messages
18,034
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
Thanks for your help but this doesn't seem to work
Can you elaborate on what "doesn't seem to work"? What exactly happens when you run the code after adding the line I posted? Do you get an error message or .....?
 
Upvote 0

Forum statistics

Threads
1,186,997
Messages
5,961,009
Members
438,514
Latest member
AngSP

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