Make cells mandatory ONLY for other users not me as the editor

[Moseth]

I am making cells mandatory to fill before save in excel. however I cannot leave them empty as then it wont let me save the document. i want to be able to save the document with the cells blank but I dont want others to be able to save the form blank. here is my code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)


'Mandatory Dependant Questions
If Application.Sheets("WERS ALERT SHEET V14").Range("C16").Value = "Yes" And _
Application.Sheets("WERS ALERT SHEET V14").Range("K16").Value = "" Then
Cancel = True
'If you want you can tell the user what he needs to fill in below instead of just Fill in Madatory fields
MsgBox "Save Cancelled, Mandatory Fields Not Filled!"
End If




'Check Cell ranges if any one of these cells are empty dont save and prompt user to fill
If Application.Sheets("WERS ALERT SHEET V14").Range("C5").Value = "" Or _
Application.Sheets("WERS ALERT SHEET V14").Range("C39").Value = "" Then
Cancel = True
MsgBox "Save Cancelled, Mandatory Fields Not Filled!"
End If




Const alertNo As String = "$C$8"
Const aimsNos As String = "$D$14"
Const aimsWhy As String = "$H$14"
Const probDef As String = "$C$29"
Const partFit As String = "$E$18"
Const partWhy As String = "$H$18"
Const partWrk As String = "$C$16"
Const vehWork As String = "$C$17"
Const partRis As String = "$K$16"
Const vehRis As String = "$K$17"


Dim wers_sht As Worksheet

For Each wers_sht In Me.Worksheets
If InStr(wers_sht.Name, "WERS ALERT") > 0 Then
Exit For
End If
Next wers_sht

With wers_sht
'Check to enable saving of the blank document
If .Range(alertNo).Value = vbNullString Then Exit Sub

'Check that either an AIMS No. as been provided or a valid reason has been given for why there isn't one
If .Range(aimsNos).Value = vbNullString Then
If Len(.Range(aimsWhy).Value) < 5 Then
MsgBox "As no AIMS reference has been provided, you are required to state why the alert is required (Row 14 Column H)", vbExclamation, wers_sht.Name
.Range(aimsWhy).Activate
Cancel = True
Exit Sub
End If
End If

'Check that the problem definition has been given
If Len(.Range(probDef).Value) < 5 Then
MsgBox "Please enter a valid Problem Definition before saving (Row 29 and 30).", vbExclamation, wers_sht.Name
.Range(probDef).Activate
Cancel = True
Exit Sub
End If

'In the case that the part is said to be fit for function, give an explanation as to why
If .Range(partFit).Value = "Yes" Then
If Len(.Range(partWhy).Value) < 5 Then
MsgBox "Please enter a valid explanation as to why the part is fit for function and " & _
"saleable for the vehicle's purpose / customer before saving (Row 18 Column H).", vbExclamation, wers_sht.Name
.Range(partWhy).Activate
Cancel = True
Exit Sub
End If

'Ensure neither of the rework fields have been selected too
If .Range(partWrk).Value = "Yes" Or .Range(vehWork).Value = "Yes" Then
GoTo tooManyYes
End If
Else
'Check that exactly one of the rework fields have been selected and that the relevant RIS field has been filled out
If .Range(partWrk).Value = "Yes" And .Range(vehWork).Value <> "Yes" Then
If .Range(partRis).Value = vbNullString Then
MsgBox "Please enter a valid Part RIS Number before saving (Row 16 Column K).", vbExclamation, wers_sht.Name
.Range(partRis).Activate
Cancel = True
Exit Sub
End If
ElseIf .Range(partWrk).Value <> "Yes" And .Range(vehWork).Value = "Yes" Then
If .Range(vehRis).Value = vbNullString Then
MsgBox "Please enter a valid Vehicle RIS Number before saving (Row 17 Column K).", vbExclamation, wers_sht.Name
.Range(vehRis).Activate
Cancel = True
Exit Sub
End If
Else
tooManyYes:
'If anything other than exactly one has been selected (0, 2, 3) then this message box is presented
MsgBox "Please select 'Yes' for exactly one of the following: " & vbCrLf & _
vbCrLf & Chr(183) & " Does the part need rework prior to fitment? (Row 16 Column C)" & _
vbCrLf & Chr(183) & " Do vehicles require Re-Work post fitment? (Row 17 Column C)" & _
vbCrLf & Chr(183) & " Is the part fit for function and saleable for the vehicle's purpose / customer? (Row 18 Column E)" & _
vbCrLf & vbCrLf & "Then populate the related fields (RIS Number - Row 16 or 17 Column K, or explanation - Row 18 Column H) before saving.", vbExclamation, wers_sht.Name
Cancel = True
Exit Sub
End If
End If
End With


End Sub

 

[Yongle]

Try this method
Firstly determine your user name with this

MsgBox Application.UserName

and then use that value to exit out of the sub if you are the user like this:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
  If Application.UserName = "[COLOR=#ff0000]yongle[/COLOR]" Then Exit Sub

   'YOUR CODE GOES HERE
End Sub

 

[Moseth]

Thankyou Working!