Lock and Unlock Files and Sheets

Note: This webpage is designed to accompany the Youtube video posted above. The video offers detailed explanation on all topics; while this webpage will serve as a repository for the code presented in the video.

Each code block covered in the video is given below.

Learn to lock and open locked files and sheets. And did you know that you could lock a certain area within a worksheet, while keeping the rest of the sheet locked? This is a handy technique when creating files where you expect the user to fill in some data and send the file back to you. In this deep-dive video, we will look some tips such as allowing users to filter on the data, while locking the data itself.

Lock Files

Sub Solution_Lock_File()
    
    Dim filePath As String
    filePath = ThisWorkbook.Path
    
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim sFileName As String
    
    Set wb = Workbooks.Add
    Set ws = wb.Sheets("Sheet1")
    wsData.Range("A1").CurrentRegion.Copy ws.Range("A1")
    sFileName = filePath & "\LockedFile"
    wb.SaveAs sFileName, FileFormat:=xlWorkbookDefault, Password:="pwdFile"
    wb.Close savechanges:=False
    
End Sub

Unlock Files

Sub Solution_UnLock_File()

    Dim filePath As String
    filePath = ThisWorkbook.Path
    Dim sFileName As String
    sFileName = filePath & "\LockedFile.xlsx"
    Dim wb As Workbook
    Set wb = Workbooks.Open(sFileName, Password:="pwdFile")
    
End Sub

Lock Worksheet

Sub Solution_Lock_Worksheet()

    Dim filePath As String
    filePath = ThisWorkbook.Path
    
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim sFileName As String
    
    Set wb = Workbooks.Add
    Set ws = wb.Sheets("Sheet1")
    wsData.Range("A1").CurrentRegion.Copy ws.Range("A1")
    ws.Columns.AutoFit
    ws.Protect Password:="pwdSheet"
    sFileName = filePath & "\LockedFile"
    wb.SaveAs sFileName, FileFormat:=xlWorkbookDefault
    wb.Close savechanges:=False

End Sub

Unlock Worksheet

Sub Solution_UnLock_Worksheet()

    Dim filePath As String
    filePath = ThisWorkbook.Path
    Dim sFileName As String
    sFileName = filePath & "\LockedFile.xlsx"
    Dim wb As Workbook
    Set wb = Workbooks.Open(sFileName)
    Dim ws As Worksheet
    Set ws = wb.Sheets("sheet1")
    ws.Unprotect Password:="pwdSheet"
    ws.Range("A1").Interior.Color = RGB(255, 0, 0)
    ws.Protect Password:="pwdSheet"
    wb.Save
    wb.Close savechanges:=False

End Sub

Lock Worksheet/ Keep Filters On

Sub Solution_Lock_Worksheet_Add_AutoFilters()

    Dim filePath As String
    filePath = ThisWorkbook.Path
    
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim sFileName As String
    
    Set wb = Workbooks.Add
    Set ws = wb.Sheets("Sheet1")
    wsData.Range("A1").CurrentRegion.Copy ws.Range("A1")
    ws.Columns.AutoFit
    ws.Range("A1").AutoFilter
    ws.Protect Password:="pwdSheet", AllowFiltering:=True
    sFileName = filePath & "\LockedFile"
    wb.SaveAs sFileName, FileFormat:=xlWorkbookDefault
    wb.Close savechanges:=False
    
End Sub

Lock Part of a Worksheet

Sub Solution_Lock_Worksheet_Unlock_One_Col()

    Dim filePath As String
    filePath = ThisWorkbook.Path
    
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim sFileName As String
    
    Set wb = Workbooks.Add
    Set ws = wb.Sheets("Sheet1")
    wsData.Range("A1").CurrentRegion.Copy ws.Range("A1")
    ws.Columns.AutoFit
    ws.Range("F1").Value = "Comments"
    Dim lrow As Long
    lrow = ws.Range("A1").CurrentRegion.Rows.Count
    ws.Range("F2:F" & lrow).Locked = False
    ws.Protect Password:="pwdSheet"
    sFileName = filePath & "\LockedFile"
    wb.SaveAs sFileName, FileFormat:=xlWorkbookDefault
    wb.Close savechanges:=False

End Sub

Related Posts