VBA Code to Zoom Data Validation Drop Down Menu Won't Work in Protected Sheet

[EFD]

Hello forum! I have a challenge that I need help with concerning VBA and sheet protection. I have created Data Validation Drop Down Menus in a Worksheet to allow selection from certain lists stored in another sheet. Initially, the font of the options in the drop down menu list was extremely small. I entered the following VBA formula to auto zoom when these cells were selected and return to normal zoom when any other cell was selected:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim rngDV As Range
Dim intZoom As Integer
Dim intZoomDV As Integer
intZoom = 50
intZoomDV = 85
Application.EnableEvents = False
On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo errHandler
If rngDV Is Nothing Then GoTo errHandler
If Intersect(Target, rngDV) Is Nothing Then
With ActiveWindow
If .Zoom <> intZoom Then
.Zoom = intZoom
End If
End With
Else
With ActiveWindow
If .Zoom <> intZoomDV Then
.Zoom = intZoomDV
End If
End With
End If
exitHandler:
Application.EnableEvents = True
Exit Sub
errHandler:
GoTo exitHandler

End Sub

I protected other formula containing cells in the workbook and protected the sheet. Now the VBA isn't able to execute and I once again have extremely small font when I try to select from the drop down menus. Does anyone have a fix for this?

Thanks for the help!

[kev_]

1. Please Edit your post by adding code tags around your code
- click Edit Post
- select code text
- click on # icon above

2. Your could try UnProtecting the sheet in the VBA just before zooming and Protecting it again after zooming

Me.UnProtect Password:="YourPassword"
'Zoom ....
Me.Protect Password:="YourPassword"

Or
3. Reduce the font size in your cells (by format) and then zoom the sheet to make cell text look bigger. That should eliminate the problem without changing zoom every dropdown.

[EFD]

Thanks for the reply kev_. Where would I insert those pieces into the code?

[kev_]

Try
UnProtect immediately below
If Intersect.....
Protect immediately above
Exit Sub

It would be easier to read your code if you indent things - then can work out what belongs together...like this ...

With Sheet(X)
   If a = b Then
      Do something
   Else
      Do something
   End If
End With

I usually include a line at the beginning of most of my selection change event macros

If Selection.CountLarge > 1 Then Exit Sub

This can prevent problems if you select a large number of cells

[EFD]

It didn't work with that arrangement. (New to the VBA coding...not sure where I should be indenting lol)

[kev_]

What does "did not work" mean?

You did change "YourPassword" to the correct value, I hope

First - let's check that the sheet is being unprotected
- leave out the Protect line at the end
- and try selecting a dropdown
- now manually check status of protection
- sheet should be unprotected

[EFD]

Still protected following the steps above after selecting a drop down

[EFD]

Yes I changed the text to the protection password. By not work, I mean that in "protected mode" the Zoom feature from the VBA was not functioning with the Unprotect/Protect code in those spots.

[kev_]

Try moving Unprotect to the FIRST line of your code
- I think the protection is preventing the macro from triggering

If that works then you will need to amend a couple of lines in your macro

Let me know and I will test a couple of things on your macro when i get home

[EFD]

With the Unprotect line directly under the "Sub" line, it simply unprotects the workbook as soon as I save the code.

[kev_]

It sounds as though the protection is interfering with the event macro, even after the sheet has been unprotected - which I would not expect.
I will get back to you after I test it on my PC.

[kev_]

This works for me
- try out in attached workbook
- sheet is protected (password = "ABCD")
- cells A1 to A20 contain DV
- select any of those cells and zoom = 85%
- select any other cell and zoom = 50%

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim X As Variant
Me.Unprotect "ABCD"

On Error Resume Next
  X = Target.Validation.Type
On Error GoTo 0
    If IsEmpty(X) Then
        ActiveWindow.Zoom = 50
    Else
        ActiveWindow.Zoom = 85
    End If

Me.Protect "ABCD"
End Sub