I am trying to lock cells A4:A500. When i protect my sheet, the VBA will not work so i tried to add the Sub unpotect and protect in but I keep getting this error. Any Ideas? Thank for the help.
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim isect As Range
Dim cell As Range
Dim dd As Variant
Dim i As Long
Dim mtch As Boolean
Dim msg As String
Dim myEntries As String
unprotect
Set isect = Intersect(Range("H4:H500"), Target)
' Exit if updated cells do not fall in H4:H500
If Not isect Is Nothing Then
Application.EnableEvents = False
' Set drop-down values
dd = Array("Test", "Test 2")
' Loop through all intersecting cells
For Each cell In isect
' See if cell entry matches any drop-down values
mtch = False
For i = LBound(dd) To UBound(dd)
If cell.Value = dd(i) Then
mtch = True
Exit For
End If
Next i
' If value is not in list, erase and return message
If mtch = False Then
cell.ClearContents
msg = msg & cell.Address(0, 0) & ","
End If
Next cell
' Build string of validation entries
For i = LBound(dd) To UBound(dd)
myEntries = myEntries & dd(i) & ","
Next i
myEntries = Left(myEntries, Len(myEntries) - 1)
' Reset validation
With Range("H4:H500").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=myEntries
' .IgnoreBlank = True
' .InCellDropdown = True
' .InputTitle = ""
' .ErrorTitle = ""
' .InputMessage = ""
' .ErrorMessage = ""
' .ShowInput = True
' .ShowError = True
End With
' Return message, if necessary
If Len(msg) > 0 Then
MsgBox "Invalid entries in cells: " & vbCrLf & Left(msg, Len(msg) - 1), vbOKOnly, "ERROR!"
End If
End If
Set isect = Intersect(Range("G4:G500"), Target)
' Exit if updated cells do not fall in G4:G500
If Not isect Is Nothing Then
Application.EnableEvents = False
' Set drop-down values
dd = Array("Test 3", "Test 4")
' Loop through all intersecting cells
For Each cell In isect
' See if cell entry matches any drop-down values
mtch = False
For i = LBound(dd) To UBound(dd)
If cell.Value = dd(i) Then
mtch = True
Exit For
End If
Next i
' If value is not in list, erase and return message
If mtch = False Then
cell.ClearContents
msg = msg & cell.Address(0, 0) & ","
End If
Next cell
' Build string of validation entries
For i = LBound(dd) To UBound(dd)
myEntries = myEntries & dd(i) & ","
Next i
myEntries = Left(myEntries, Len(myEntries) - 1)
' Reset validation
With Range("G4:G500").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=myEntries
' .IgnoreBlank = True
' .InCellDropdown = True
' .InputTitle = ""
' .ErrorTitle = ""
' .InputMessage = ""
' .ErrorMessage = ""
' .ShowInput = True
' .ShowError = True
End With
' Return message, if necessary
If Len(msg) > 0 Then
MsgBox "Invalid entries in cells: " & vbCrLf & Left(msg, Len(msg) - 1), vbOKOnly, "ERROR!"
End If
End If
Set isect = Intersect(Range("B4:B500"), Target)
' Exit if updated cells do not fall in B4:B500
If Not isect Is Nothing Then
Application.EnableEvents = False
' Set drop-down values
dd = Array("Division 1", "Division 2", "", "Division 3")
' Loop through all intersecting cells
For Each cell In isect
' See if cell entry matches any drop-down values
mtch = False
For i = LBound(dd) To UBound(dd)
If cell.Value = dd(i) Then
mtch = True
Exit For
End If
Next i
' If value is not in list, erase and return message
If mtch = False Then
cell.ClearContents
msg = msg & cell.Address(0, 0) & ","
End If
Next cell
' Build string of validation entries
For i = LBound(dd) To UBound(dd)
myEntries = myEntries & dd(i) & ","
Next i
myEntries = Left(myEntries, Len(myEntries) - 1)
' Reset validation
With Range("B4:B500").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=myEntries
' .IgnoreBlank = True
' .InCellDropdown = True
' .InputTitle = ""
' .ErrorTitle = ""
' .InputMessage = ""
' .ErrorMessage = ""
' .ShowInput = True
' .ShowError = True
End With
' Return message, if necessary
If Len(msg) > 0 Then
MsgBox "Invalid entries in cells: " & vbCrLf & Left(msg, Len(msg) - 1), vbOKOnly, "ERROR!"
End If
End If
Application.EnableEvents = True
protect
End Sub
Sub unprotect()
ThisWorkbook.Sheets("Sheet3").unprotect "FPA"
ThisWorkbook.Sheets("Sheet2").unprotect "FPA"
End Sub
Sub protect()
ThisWorkbook.Sheets("Sheet3").protect "FPA"
ThisWorkbook.Sheets("Sheet2").protect "FPA"
End Sub