Locking Sheets

Guides • VBA • 12/01/2021
Here we show how VBA can be used to lock workbook sheets.
Screenshots

Click to view large-sized image
Click to view large-sized image
VBA Module Code – Locking Sheets

VBA
Sub sbProtectSheetJan()

Dim answer As Integer
answer = MsgBox("NOTE:" & Chr(13) & "Are you sure you want to LOCK the submission for January?" & Chr(13) & "You will not be able to unlock the submission after this step.", vbYesNo + vbQuestion, "Please Confirm!")

If answer = vbYes Then
 
    ActiveSheet.Protect "007050609WunderRockPossible", True, True
    
    Sheets("Summary").Select
    ActiveSheet.Unprotect "007050609WunderRockPossible"
    
    Range("C6").Select
    ActiveCell.FormulaR1C1 = "ü"
    
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Selection.Font.Size = 14
    
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    
    ActiveSheet.Protect "007050609WunderRockPossible", True, True
    
    Sheets("Jan").Select
    Range("A1").Select
    MsgBox "January's data has been successfully LOCKED for submission" & Chr(13) & "These records can now be SUBMITTED", vbInformation, "Successfully Locked"
       
Else
    'do nothing
End If

End Sub



Sub sbProtectSheetFeb()

Dim answer As Integer
answer = MsgBox("NOTE:" & Chr(13) & "Are you sure you want to LOCK the submission for February?" & Chr(13) & "You will not be able to unlock the submission after this step.", vbYesNo + vbQuestion, "Please Confirm!")

If answer = vbYes Then
 
    ActiveSheet.Protect "007050609WunderRockPossible", True, True
    
    Sheets("Summary").Select
    ActiveSheet.Unprotect "007050609WunderRockPossible"
    
    Range("D6").Select
    ActiveCell.FormulaR1C1 = "ü"
    
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Selection.Font.Size = 14
    
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    
    ActiveSheet.Protect "007050609WunderRockPossible", True, True
    
    Sheets("Feb").Select
    Range("A1").Select
    MsgBox "February's data has been successfully LOCKED for submission" & Chr(13) & "These records can now be SUBMITTED", vbInformation, "Successfully Locked"
     
Else
    'do nothing
End If

End Sub



Sub sbProtectSheetMar()

Dim answer As Integer
answer = MsgBox("NOTE:" & Chr(13) & "Are you sure you want to LOCK the submission for March?" & Chr(13) & "You will not be able to unlock the submission after this step.", vbYesNo + vbQuestion, "Please Confirm!")

If answer = vbYes Then
 
    ActiveSheet.Protect "007050609WunderRockPossible", True, True
    
    Sheets("Summary").Select
    ActiveSheet.Unprotect "007050609WunderRockPossible"
    
    Range("E6").Select
    ActiveCell.FormulaR1C1 = "ü"
    
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Selection.Font.Size = 14
    
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    
    ActiveSheet.Protect "007050609WunderRockPossible", True, True
    
    Sheets("Mar").Select
    Range("A1").Select
    MsgBox "March's data has been successfully LOCKED for submission" & Chr(13) & "These records can now be SUBMITTED", vbInformation, "Successfully Locked"
     
Else
    'do nothing
End If

End Sub



Sub sbProtectSheetApr()

Dim answer As Integer
answer = MsgBox("NOTE:" & Chr(13) & "Are you sure you want to LOCK the submission for April?" & Chr(13) & "You will not be able to unlock the submission after this step.", vbYesNo + vbQuestion, "Please Confirm!")

If answer = vbYes Then
 
    ActiveSheet.Protect "007050609WunderRockPossible", True, True
    
    Sheets("Summary").Select
    ActiveSheet.Unprotect "007050609WunderRockPossible"
    
    Range("F6").Select
    ActiveCell.FormulaR1C1 = "ü"
    
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Selection.Font.Size = 14
    
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    
    ActiveSheet.Protect "007050609WunderRockPossible", True, True
    
    Sheets("Apr").Select
    Range("A1").Select
    MsgBox "April's data has been successfully LOCKED for submission" & Chr(13) & "These records can now be SUBMITTED", vbInformation, "Successfully Locked"
  
Else
    'do nothing
End If

End Sub



Sub sbProtectSheetMay()

Dim answer As Integer
answer = MsgBox("NOTE:" & Chr(13) & "Are you sure you want to LOCK the submission for May?" & Chr(13) & "You will not be able to unlock the submission after this step.", vbYesNo + vbQuestion, "Please Confirm!")

If answer = vbYes Then
 
    ActiveSheet.Protect "007050609WunderRockPossible", True, True
    
    Sheets("Summary").Select
    ActiveSheet.Unprotect "007050609WunderRockPossible"
    
    Range("G6").Select
    ActiveCell.FormulaR1C1 = "ü"
    
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Selection.Font.Size = 14
    
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    
    ActiveSheet.Protect "007050609WunderRockPossible", True, True
    
    Sheets("May").Select
    Range("A1").Select
    MsgBox "May's data has been successfully LOCKED for submission" & Chr(13) & "These records can now be SUBMITTED", vbInformation, "Successfully Locked"
    
Else
    'do nothing
End If

End Sub

    
    
Sub sbProtectSheetJun()

Dim answer As Integer
answer = MsgBox("NOTE:" & Chr(13) & "Are you sure you want to LOCK the submission for June?" & Chr(13) & "You will not be able to unlock the submission after this step.", vbYesNo + vbQuestion, "Please Confirm!")

If answer = vbYes Then
 
    ActiveSheet.Protect "007050609WunderRockPossible", True, True
    
    Sheets("Summary").Select
    ActiveSheet.Unprotect "007050609WunderRockPossible"
    
    Range("H6").Select
    ActiveCell.FormulaR1C1 = "ü"
    
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Selection.Font.Size = 14
    
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    
    ActiveSheet.Protect "007050609WunderRockPossible", True, True
    
    Sheets("Jun").Select
    Range("A1").Select
    MsgBox "June's data has been successfully LOCKED for submission" & Chr(13) & "These records can now be SUBMITTED", vbInformation, "Successfully Locked"
      
Else
    'do nothing
End If

End Sub



Sub sbProtectSheetJul()

Dim answer As Integer
answer = MsgBox("NOTE:" & Chr(13) & "Are you sure you want to LOCK the submission for July?" & Chr(13) & "You will not be able to unlock the submission after this step.", vbYesNo + vbQuestion, "Please Confirm!")

If answer = vbYes Then
 
    ActiveSheet.Protect "007050609WunderRockPossible", True, True
    
    Sheets("Summary").Select
    ActiveSheet.Unprotect "007050609WunderRockPossible"
    
    Range("I6").Select
    ActiveCell.FormulaR1C1 = "ü"
    
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Selection.Font.Size = 14
    
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    
    ActiveSheet.Protect "007050609WunderRockPossible", True, True
    
    Sheets("Jul").Select
    Range("A1").Select
    MsgBox "July's data has been successfully LOCKED for submission" & Chr(13) & "These records can now be SUBMITTED", vbInformation, "Successfully Locked"
     
Else
    'do nothing
End If

End Sub



Sub sbProtectSheetAug()

Dim answer As Integer
answer = MsgBox("NOTE:" & Chr(13) & "Are you sure you want to LOCK the submission for August?" & Chr(13) & "You will not be able to unlock the submission after this step.", vbYesNo + vbQuestion, "Please Confirm!")

If answer = vbYes Then
 
    ActiveSheet.Protect "007050609WunderRockPossible", True, True
    
    Sheets("Summary").Select
    ActiveSheet.Unprotect "007050609WunderRockPossible"
    
    Range("J6").Select
    ActiveCell.FormulaR1C1 = "ü"
    
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Selection.Font.Size = 14
    
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    
    ActiveSheet.Protect "007050609WunderRockPossible", True, True
    
    Sheets("Aug").Select
    Range("A1").Select
    MsgBox "August's data has been successfully LOCKED for submission" & Chr(13) & "These records can now be SUBMITTED", vbInformation, "Successfully Locked"
    
Else
    'do nothing
End If

End Sub



Sub sbProtectSheetSep()

Dim answer As Integer
answer = MsgBox("NOTE:" & Chr(13) & "Are you sure you want to LOCK the submission for September?" & Chr(13) & "You will not be able to unlock the submission after this step.", vbYesNo + vbQuestion, "Please Confirm!")

If answer = vbYes Then
 
    ActiveSheet.Protect "007050609WunderRockPossible", True, True
    
    Sheets("Summary").Select
    ActiveSheet.Unprotect "007050609WunderRockPossible"
    
    Range("K6").Select
    ActiveCell.FormulaR1C1 = "ü"
    
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Selection.Font.Size = 14
    
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    
    ActiveSheet.Protect "007050609WunderRockPossible", True, True
    
    Sheets("Sep").Select
    Range("A1").Select
    MsgBox "September's data has been successfully LOCKED for submission" & Chr(13) & "These records can now be SUBMITTED", vbInformation, "Successfully Locked"
    
Else
    'do nothing
End If

End Sub



Sub sbProtectSheetOct()

Dim answer As Integer
answer = MsgBox("NOTE:" & Chr(13) & "Are you sure you want to LOCK the submission for October?" & Chr(13) & "You will not be able to unlock the submission after this step.", vbYesNo + vbQuestion, "Please Confirm!")

If answer = vbYes Then
 
    ActiveSheet.Protect "007050609WunderRockPossible", True, True
    
    Sheets("Summary").Select
    ActiveSheet.Unprotect "007050609WunderRockPossible"
    
    Range("L6").Select
    ActiveCell.FormulaR1C1 = "ü"
    
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Selection.Font.Size = 14
    
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    
    ActiveSheet.Protect "007050609WunderRockPossible", True, True
    
    Sheets("Oct").Select
    Range("A1").Select
    MsgBox "October's data has been successfully LOCKED for submission" & Chr(13) & "These records can now be SUBMITTED", vbInformation, "Successfully Locked"
  
Else
    'do nothing
End If

End Sub



Sub sbProtectSheetNov()

Dim answer As Integer
answer = MsgBox("NOTE:" & Chr(13) & "Are you sure you want to LOCK the submission for November?" & Chr(13) & "You will not be able to unlock the submission after this step.", vbYesNo + vbQuestion, "Please Confirm!")

If answer = vbYes Then
 
    ActiveSheet.Protect "007050609WunderRockPossible", True, True
    
    Sheets("Summary").Select
    ActiveSheet.Unprotect "007050609WunderRockPossible"
    
    Range("M6").Select
    ActiveCell.FormulaR1C1 = "ü"
    
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Selection.Font.Size = 14
    
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    
    ActiveSheet.Protect "007050609WunderRockPossible", True, True
    
    Sheets("Nov").Select
    Range("A1").Select
    MsgBox "November's data has been successfully LOCKED for submission" & Chr(13) & "These records can now be SUBMITTED", vbInformation, "Successfully Locked"
  
Else
    'do nothing
End If

End Sub



Sub sbProtectSheetDec()

Dim answer As Integer
answer = MsgBox("NOTE:" & Chr(13) & "Are you sure you want to LOCK the submission for December?" & Chr(13) & "You will not be able to unlock the submission after this step.", vbYesNo + vbQuestion, "Please Confirm!")

If answer = vbYes Then
 
    ActiveSheet.Protect "007050609WunderRockPossible", True, True
    
    Sheets("Summary").Select
    ActiveSheet.Unprotect "007050609WunderRockPossible"
    
    Range("N6").Select
    ActiveCell.FormulaR1C1 = "ü"
    
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Selection.Font.Size = 14
    
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    
    ActiveSheet.Protect "007050609WunderRockPossible", True, True
    
    Sheets("Dec").Select
    Range("A1").Select
    MsgBox "December's data has been successfully LOCKED for submission" & Chr(13) & "These records can now be SUBMITTED", vbInformation, "Successfully Locked"
         
Else
    'do nothing
End If

End Sub
Download

The full file can be downloaded here:
VBA - Locking Sheets (xlsm)
Locking Sheets

Screenshots

VBA - Locking Sheets

VBA Module Code – Locking Sheets

Download

Feedback
