Vba code to lock a range of cells before saving

I am generating a sheets wherein I want to check whether the cells are filled and if they contain some values then lock those cells on clicking save button. My code is as given below:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Sheets("Sheet18").Unprotect Password:="****"
Sheets("Sheet19").Unprotect Password:="****"
Sheets("Sheet20").Unprotect Password:="****"
Sheets("Sheet21").Unprotect Password:="****"
Sheets("Sheet22").Unprotect Password:="****"
ActiveSheet.Protect Contents:=False
For Each Cell In Range("H5:H24,J5:J24")
If Cell <> "" Then Cell.Locked = True
If Cell = "" Then Cell.Locked = False
Next
ActiveSheet.Protect Contents:=True
Sheets("Sheet18").Protect Password:="****"
Sheets("Sheet18").Protect UserInterfaceOnly:=True
Sheets("Sheet19").Protect Password:="****"
Sheets("Sheet19").Protect UserInterfaceOnly:=True
Sheets("Sheet20").Protect Password:="****"
Sheets("Sheet20").Protect UserInterfaceOnly:=True
Sheets("Sheet21").Protect Password:="****"
Sheets("Sheet21").Protect UserInterfaceOnly:=True
Sheets("Sheet22").Protect Password:="****"
Sheets("Sheet22").Protect UserInterfaceOnly:=True
End Sub

Whenever I click on save, it asks me to unprotect sheets individually using the password. What is the problem?