Excel VBA validation errors when a spreadsheet is proteced - vba

Question

I'm trying to ensure that data entered into the named range of an Excel spreadsheet is valid. To do this, I've defined a static validation list for column "A" in the range, and enabled the dropdown list for that column. Based on the option selected by the user, I add a validation object in column "B" at runtime, having a list of entries constrained by the entry in column "A". Based on the entries in columns A and B, the cell in column "C" is automatically populated.
This works fine until spreadsheet protection is enabled. At that point, attempting to select an option from the droplist in column "B" generates the following error:
"The cell or chart that you are trying to change is protected and therefore read-only. ... "
However
All cells in the range in question were unlocked prior to adding
worksheet protection.
The code explicitly removes protection prior to updating the
validation object in column "B", then replaces it once the validation
object has been added.
When a list item is selected from the droplist in column "B", the
error message fires immediately before any worksheet events occur,
making it impossible to trap or debug the error.
I have code in both the spreadsheet and in a separate code module, both or which are included below. Any ideas would be greatly appreciated
Here's the code in the Worksheet_Change() event:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim strNm As String
' there will be multiple named ranges eventually. We need to be able to distinguish
' among the various ranges so that our code executes only against the data we expect
' to manipulate - not random cells
If Not Intersect(ActiveCell, ActiveWorkbook.Names("DBAddRange").RefersToRange) Is Nothing Then
Dim rng As Range
Set rng = ActiveWorkbook.Names("DBAddRange").RefersToRange
If Target.Column = 1 Then
If FLAG_CHANGE_IN_PROGRESS = True Then Exit Sub
FLAG_CHANGE_IN_PROGRESS = True
Dim VldnList As String
VldnList = getVldtnList(Target.Value)
unlockSS ActiveSheet
Range("B" & Target.row).Clear
Range("B" & Target.row).Select
With Range("B" & Target.row).Validation
.Delete
.Add Type:=xlValidateList, Operator:=xlValidateList, Formula1:=VldnList
.IgnoreBlank = False
.InCellDropdown = True
End With
lockSS ActiveSheet
Range("B" & Target.row).Select
FLAG_CHANGE_IN_PROGRESS = False
ElseIf Target.Column = 2 Then
If FLAG_CHANGE_IN_PROGRESS = True Then Exit Sub
FLAG_CHANGE_IN_PROGRESS = True
unlockSS ActiveSheet
Dim dbHost As Variant
Dim hNmRng As Range
Set hNmRng = ActiveWorkbook.Names("valid_lookups").RefersToRange
dbHost = Application.VLookup(Target.Value, hNmRng, 2, False)
Range("C" & Target.row).Value = dbHost
lockSS ActiveSheet
FLAG_CHANGE_IN_PROGRESS = False
End If
End If
If Not Intersect(ActiveCell, ActiveWorkbook.Names("HostAddRange").RefersToRange) Is Nothing Then
End If
End Sub
Code in the external module:
Sub lockSS(ByVal sheet As Sheet1)
sheet.Protect Password:=[NOT SHOWN], UserInterfaceOnly:=True, DrawingObjects:=False
Application.EnableEvents = True
End Sub
Function getVldtnList(ByVal dbName As String)
Dim vrtmatchRow As Variant
Dim rng As Range
If dbName = "" Then
getVldtnList = ""
Exit Function
End If
' this is a pre-defined range having entries for:
' DB Name - Column 1
' DB CI ID - Column 2
' DB Host - Column 3
Set rng = ActiveWorkbook.Names("valid_db_nms").RefersToRange
' find the value of the first row in the range that matches the value
' of the dbName parm. NOTE: the final 0 parm tells the match function
' to find an exact match.
vrtmatchRow = Application.Match(dbName, rng, 0)
If IsError(vrtmatchRow) Then
' NOTE: we should NEVER get here due to the way cell validation is set up.
MsgBox "The value entered was not found in the list of valid database values. See xxx for help", vbRetryCancel, "Invalid Entry"
Else
Dim row As Long
Dim strListVals As String
Set rng = ActiveWorkbook.Names("valid_db_info").RefersToRange
row = vrtmatchRow
Do
If Len(strListVals) > 0 Then strListVals = strListVals + ","
strListVals = strListVals + rng.Cells(row, 2).Value
row = row + 1
Loop While (rng.Cells(row, 1).Value = dbName)
End If
getVldtnList = strListVals
End Function
Sub unlockSS(ByVal sheet As Sheet1)
sheet.Unprotect Password:=[NOT SHOWN]
Application.EnableEvents = False
End Sub

Answer 1

Clearing a range will also reset the "locked" checkbox, so you need to reset that each time
Range("B" & Target.row).Clear