Error when Validation "Input message" modified by "Selectionchange" event in VBA

[julie_nickb]

I have have succeeded in modifying the Validation Input message for my input cells, by using the "Selectionchange" event in VBA.

All worked fine, until I did the following:

- used the "Format Cells" "Protection" tab to uncheck the "Locked" box for the input cells
- Protected the sheet with the "Review" tab

Now, when I click on my "Unlocked" cell, I get the following message:

Run time error 1004
Application defined or Object defined error

This is the code line where the error occurs.
.InputMessage = "YES"

If I unprotect the sheet, it works.
If I take out the modification of the Inputmessage, it does not crash.
Help please!

 

[Fluff]

Can you post your entire code.

 

[julie_nickb]

Can you post your entire cod

With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:="=Scoring_Algorithm!L6:L11"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = "Select"
.ErrorTitle = ""
.InputMessage = InputMessage1
.ErrorMessage = Errormessage1
.ShowInput = True
.ShowError = True
End With

 

[Fluff]

Can you please post ALL your code & please use code tags How to Post Your VBA Code

 

[julie_nickb]

I hope this is what you mean. It's my first time sending code.

[CODE=vba]Private Sub Worksheet_SelectionChange(ByVal Target As Range)

 Dbug = 0
 Call Evaluation_SelectionChange(Dbug)
End Sub

Sub Evaluation_SelectionChange(Dbug)
            
Dim Inr As Boolean
Dim InputMessage1 As String
Dim Inputmessage2 As String
Dim Errormessage1 As String
Dim Errormessage2 As String


Dim Destabbrev, R1name, R2name As Variant 'String  'destination abbreviation
Dim Sheetname1 As Variant

 
' There are two different drop-down menus for the input message on this sheet.

' For all other than "Past Performance" and "Performance Tracking", named range SVC_Evaluation_Selection1,the message is
' ("Never" & vbNewLine & "Rarely" & vbNewLine & "Sometimes" & vbNewLine & "Always") in English or French

' For "Past Performance" and "Performance Tracking", named range SVC_Evaluation_Selection2
'("1 Does not meet" vbNewLine "2 Meets with opportunities" vbNewLine "3 Meets all" vbNewLine "4 Exceeds with opportunities" vbNewLine "5 Exceeds" )
'in English or in French

  
  
    
  Sheetname1 = ActiveSheet.Name
  
  Destabbrev = Splitstring(Sheetname1)
    
   If Dbug = 1 Then
    MsgBox (R1name & "Selectionchange & installing validation")
    End If
    
  R1name = Destabbrev & "_Evaluation_Selection1"
  R2name = Destabbrev & "_Evaluation_Selection2"
  
  Set RSelection1 = Range(R1name)
  Set RSelection2 = Range(R2name)
 
  Activeaddress = ActiveCell.Address
  
 ' If employee name is blank, then this cell should also be blank
 
 
 If Currentlanguage = 3 Then
    InputMessage1 = ("1 Never" & vbNewLine & "2 Rarely/Not likely" & vbNewLine & "3 Sometimes" & vbNewLine & "4 Frequently" & vbNewLine & "5 Always")
    Inputmessage2 = ("1 Does not meet" & vbNewLine & "2 Meets with opportunities" & vbNewLine & "3 Meets all" & vbNewLine & "4 Exceeds with opportunities" & vbNewLine & "5 Exceeds")
    Errormessage1 = "Try again..(1-5)"
    Else
    InputMessage1 = ("1 fNever" & vbNewLine & "2 fRarely/Not likely" & vbNewLine & "3 fSometimes" & "4 Frequently" & vbNewLine & "5 fAlways")
    Inputmessage2 = ("1 fDoes not meet" & vbNewLine & "2 fMeets with opportunities" & vbNewLine & "3 fMeets all" & vbNewLine & "4 fExceeds with opportunities" & vbNewLine & "5 fExceeds")
    Errormessage1 = "Essayez encore..(1-5)"
    End If
    

 Call TestInRange(Range(R1name), Inr)
 If (Inr = True) Then
    If Dbug = 1 Then
    MsgBox ("Change made in " & R1name & "_Evaluation_Selection1 " & Inr)
    
    End If
    End If
  
  
If Inr = True Then
With Selection.Validation
.Delete
   .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:="=Scoring_Algorithm!L6:L11"
   .IgnoreBlank = True
   .InCellDropdown = True
   .InputTitle = "Select"
   .ErrorTitle = ""
   .InputMessage = InputMessage1
   .ErrorMessage = Errormessage1
   .ShowInput = True
   .ShowError = True
   End With
   End If
   
 Call TestInRange(Range(R2name), Inr)
 
 If (Inr = True) Then
         If Dbug = 1 Then
          MsgBox ("Change made in " & R1name & "_Evaluation_Selection2 " & Inr)
           Debug.Print ("Change made in " & R1name & "_Evaluation_Selection2 " & Inr)
           End If
      End If
  
  
If Inr = True Then
With Selection.Validation
.Delete
   .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:="=Scoring_Algorithm!L6:L11"
   .IgnoreBlank = True
   .InCellDropdown = True
   .InputTitle = "Select"
   .ErrorTitle = ""
   .InputMessage = Inputmessage2
   .ErrorMessage = Errormessage1
   .ShowInput = True
   .ShowError = True
   End With
   End If
End Sub

[/CODE]

 

[Fluff]

Ok, thanks for that. It appears that you can't add data validation to a locked sheet. You will need to add code to unlock the sheet & then re-protect it again at the end.

 

[julie_nickb]

Ok, thanks for that. It appears that you can't add data validation to a locked sheet. You will need to add code to unlock the sheet & then re-protect it again at the end.

I thought that if the cell is not locked, it would work. There are about 300 cells on this sheet where it would have to unprotect the sheet, then protect.
Not logical, IMHO.
Thanks for trying.

 

[Fluff]

You're welcome & thanks for the feedback.

 

[super0mal]

I thought that if the cell is not locked, it would work. There are about 300 cells on this sheet where it would have to unprotect the sheet, then protect.
Not logical, IMHO.
Thanks for trying.

Hi Julie, OMG I have been searching for hours. I have the same issue, although my cells are not locked. Did you happen to find an answer? It seems to defy logic indeed. I love your code, and I am trying to do a very similar thing with the .Inputmessage. Please if you did eventually find the answer, please let me know.

 

[julie_nickb]

Hi Julie, OMG I have been searching for hours. I have the same issue, although my cells are not locked. Did you happen to find an answer? It seems to defy logic indeed. I love your code, and I am trying to do a very similar thing with the .Inputmessage. Please if you did eventually find the answer, please let me know.

unfortunately I didn’t find an answer. I wish…