Macro won't work properly when I protect my sheet

FSUrf02

New Member
Joined
Apr 5, 2012
Messages
7
Hello All,

Background info: I am working on Excel 2010 and running Windows 7 (64 bit).

I have a worksheet that contains a macro to create data validation combo boxes (which is pretty neat since it gives the users the autofill function). I did not write this macro, but rather obtained it from a another website. Essentially the macro allows for a user to use the combo box data validation list if they double click in a cell that already has your standard data validation list attached to it. There are also a couple additional macros that allow for the user to press tab or enter to next cell and copy and pasting on the worksheet (not even sure if I need this or not). The macro itself is working splendidly on it's own.

Here is the code for that macro:
Code:
'==========================

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
  Cancel As Boolean)
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Dim wsList As Worksheet
Set ws = ActiveSheet
Set wsList = Sheets("Employees")
Cancel = True
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
    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
  End If
  
errHandler:
  Application.EnableEvents = True
  Exit Sub
End Sub
'=========================================
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Set ws = ActiveSheet
Application.EnableEvents = False
Application.ScreenUpdating = True
If Application.CutCopyMode Then
  'allow copying and pasting on the worksheet
  GoTo errHandler
End If

Set cboTemp = ws.OLEObjects("TempCombo")
  On Error Resume Next
  With cboTemp
    .Top = 10
    .Left = 10
    .Width = 0
    .ListFillRange = ""
    .LinkedCell = ""
    .Visible = False
    .Value = ""
  End With

errHandler:
  Application.EnableEvents = True
  Exit Sub
End Sub
'====================================
'Optional code to move to next cell if Tab or Enter are pressed
'from code by Ted Lanham
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
'====================================

Next to the columns that have these data validation lists (let us say for example my cells with data validation are in columns A, C, and E), there are cells that have vlookups (say in columns B, D and F) based on the value the user selected that I will have hidden to the user. I am worried the user will try selecting across these columns at once and deleting these important vlookups, so I figured I would protect the columns that have these vlookups (B, D & F) from being deleted or altered in any way really, but keep the cells that use the combo box/data validation drop downs (columns A, C, & E) from being altered in any way.

First thing I did was lock/unlock the appropriate cells through the format menu (so I don't think this is an issue). Then, I turned the protection on this worksheet and that is where I run into the problem. The macro will no longer work. When I double click in any of the cells to bring up the combo box data validation, all it does is give me that little blue circle that spins and spins. I went through the worksheet and made sure to lock the cells. The normal data validation drop down menu still works fine as expected, however I really want the combo box one to pop up.

After doing a quick search on here I was able to find some help on the subject here: http://www.mrexcel.com/forum/showthread.php?t=337079. However, when I tried using this concept in my own macro, it still doesn't work. Here is my macro updated to include the additional code for protecting and unprotecting the workbook (I have made any additions to the previous code in Bold):
Code:
'==========================

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
  Cancel As Boolean)
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Dim wsList As Worksheet
Set ws = ActiveSheet
Set wsList = Sheets("Employees")
Cancel = True
[B]Me.Unprotect "Password"[/B]
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
    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
  End If
  
errHandler:
  Application.EnableEvents = True
  Exit Sub
[B]Me.Protect "Password"[/B]
End Sub
'=========================================
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Set ws = ActiveSheet
Application.EnableEvents = False
Application.ScreenUpdating = True
[B]Me.Unprotect "Password"[/B]
If Application.CutCopyMode Then
  'allow copying and pasting on the worksheet
  GoTo errHandler
End If

Set cboTemp = ws.OLEObjects("TempCombo")
  On Error Resume Next
  With cboTemp
    .Top = 10
    .Left = 10
    .Width = 0
    .ListFillRange = ""
    .LinkedCell = ""
    .Visible = False
    .Value = ""
  End With

errHandler:
  Application.EnableEvents = True
  Exit Sub
[B]Me.Protect "Password"[/B]
End Sub
'====================================
'Optional code to move to next cell if Tab or Enter are pressed
'from code by Ted Lanham
Private Sub TempCombo_KeyDown(ByVal _
        KeyCode As MSForms.ReturnInteger, _
        ByVal Shift As Integer)
[B]Me.Unprotect "Password"[/B]
    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
[B]Me.Protect "Password"[/B]
End Sub
'====================================


My macro still doesn't work when I added those lines in the code (does the same blue circle). Not sure if I am putting the Me.Protect/Unprotect "Password" in the wrong spot or in too many spots or not. I have tried several different combinations, none of which seem to help. I have gotten one different response (not the one I want) when changing where I put them as the second I click in one of the cells with the data validation in it, it unprotects the sheet and stays unprotected.

Sorry for being so long winded, was hoping someone could show me where I am messing up.

If you feel you need me to attach my spreadsheet, just ask. I will have to scrub it of any personal data but I can do so if need be. This is the last thing I really wanted to wrap up on this spreadsheet and of course the one area that is holding me up. TIA!
 

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple

Forum statistics

Threads
1,215,042
Messages
6,122,810
Members
449,095
Latest member
m_smith_solihull

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
Back
Top