VBA to allow users to format cells on locked worksheet

Question

I have some code on my workbook:

Sub ProtectionOptions()
 
'PURPOSE: Protect Worksheet But Allow User to Format Cells

Dim myPassword As String

'Input Password to Variable
    myPassword = "SSD84006"

'Protect Worksheet (Allow Formatting Cells)
    ActiveSheet.Protect Password:=(myPassword), AllowFormattingCells:=True
    
    
'Protect Worksheet (Allow Formatting Cells)
    ActiveSheet.Protect _
        Password:=(myPassword), _
        AllowFormattingCells:=True

 
End Sub

This allows users to be able to format cells on a worksheet that is password protected.

I have added this in as a subroutine to another routine, but regardless of what routine I add it in to, it only allows formatting once the workbook has been restarted.

Even if I add it into my code for creating a new workbook:

Sub Add_New_Briefing()
    Application.EnableEvents = False
    Call fileProtection(False, Worksheets("1900 01 01"))
    Worksheets("1900 01 01").Copy After:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = InputBox("Briefing Sheet (Date of the Monday) " & vbNewLine & "In the format of YYYY MM DD" & vbNewLine & "So 23/12/2024 would be entered 2024 12 23" & vbNewLine & "Note - there are spaces either side of MM")
    
    Call fileProtection(True)
    Application.EnableEvents = True
End Sub

I still have to restart the workbook for formatting to be available.

The other protection code I have in place is

Sub fileProtection(ByVal blnProtect As Boolean, Optional ByVal SpecificSheet As Object)
Dim ws As Worksheet
Const pw = "SSD84006"
With ThisWorkbook
    If blnProtect Then
        .Protect pw
    Else
        .Unprotect pw
    End If
    
    If SpecificSheet Is Nothing Then
        For Each ws In .Worksheets
            If blnProtect Then
                ws.Protect pw
            Else
                ws.Unprotect pw
            End If
        Next
    Else
        With SpecificSheet
            If blnProtect Then
                .Protect pw
            Else
                .Unprotect pw
            End If
        End With
    End If
End With
End Sub

Answer 1

It appears that you are using the wrong file protections routine. Combining both of your routines into one will prevent this mistake and possible conflicts between the two routines, if they were modified in the future.

Sub fileProtection(ByVal blnProtect As Boolean, Optional WorkbookProtecton As Boolean = False, Optional ByVal SpecificSheet As Worksheet, Optional AllowFormattingCells As Boolean = False)
    Dim ws As Worksheet
    Const pw = "SSD84006"
     
    If blnProtect And WorkbookProtecton Then
        ThisWorkbook.Protect pw
    ElseIf WorkbookProtecton Then
        ThisWorkbook.Unprotect pw
    End If
        
    If SpecificSheet Is Nothing Then
        For Each ws In ThisWorkbook.Worksheets
            If blnProtect Then
                ws.Protect pw, AllowFormattingCells:=AllowFormattingCells
            Else
                ws.Unprotect pw
            End If
        Next
    Else
        If blnProtect Then
            SpecificSheet.Protect pw, AllowFormattingCells:=AllowFormattingCells
        Else
            SpecificSheet.Unprotect pw
        End If
    End If
       
End Sub

Usage:

Sub Add_New_Briefing()
    Application.EnableEvents = False
    Call fileProtection(False, Worksheets("1900 01 01"))
    Worksheets("1900 01 01").Copy After:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = InputBox("Briefing Sheet (Date of the Monday) " & vbNewLine & "In the format of YYYY MM DD" & vbNewLine & "So 23/12/2024 would be entered 2024 12 23" & vbNewLine & "Note - there are spaces either side of MM")
    
    Call fileProtection(True, AllowFormattingCells:=True)
    Application.EnableEvents = True
End Sub