Protected worksheet preventing code running

[Ironman]

Hi

The below code runs as part of a Workbook Open event

Sub Fillcell(Color As Long, cValue As String)

    Application.EnableEvents = False
  
    With Selection
      .Font.Name = "Wingdings"
      .Font.Size = 12
      .Font.ColorIndex = 1
      .Value = cValue
      
      If ActiveSheet.Name = "Training Log" Then
        With Selection.Validation
          .Delete
          .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
          :=xlBetween
          .IgnoreBlank = True
          .InCellDropdown = False
          .InputTitle = ""
          .ErrorTitle = ""
          .InputMessage = "Double click for lifetime mileage total up to this date"
          .ErrorMessage = ""
          .ShowInput = True
          .ShowError = True
        End With
      End If
    
    End With
  
    With Selection.Interior
      .ColorIndex = Color
      .Pattern = xlSolid
    End With
  
    Application.EnableEvents = True
  
End Sub

However, it is interrupted at the below point by the protected status of the sheet:

.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
          :=xlBetween

I'd be grateful for a couple of lines of code that will allow all the above code to run and resume protection once it has completed.

Many thanks!

 

[DanteAmor]

Try this. Change "abc" by the password desired.

Sub Fillcell(Color As Long, cValue As String)


    Application.EnableEvents = False
  
[COLOR=#0000ff]    Activesheet.unprotect "abc"[/COLOR]


    With Selection
      .Font.Name = "Wingdings"
      .Font.Size = 12
      .Font.ColorIndex = 1
      .Value = cValue
      
      If ActiveSheet.Name = "Training Log" Then
        With Selection.Validation
          .Delete
          .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
          :=xlBetween
          .IgnoreBlank = True
          .InCellDropdown = False
          .InputTitle = ""
          .ErrorTitle = ""
          .InputMessage = "Double click for lifetime mileage total up to this date"
          .ErrorMessage = ""
          .ShowInput = True
          .ShowError = True
        End With
      End If
    
    End With
  
    With Selection.Interior
      .ColorIndex = Color
      .Pattern = xlSolid
    End With
  
[COLOR=#0000FF]    Activesheet.protect "abc"

[/COLOR]
    Application.EnableEvents = True
  
End Sub

 

[Ironman]

Hi again Dante!

Thanks ever so much, it works fine.

Best regards

 

[DanteAmor]

You're welcome and thanks for the feedback.