I have a worksheet called "Change Request Form" where users are required to
input values in the following cells:

C9 = CPM Full Name
C10 = IT PM Full Name
C11 = Change Type
C12 = Reason Category
C13 = Project Name
C14 = Release
C15 = PAT ID
C16 = PRISM ID
C17 = Explanation
E15 = New PAT ID
E16 = New PRISM ID

I want to require users to provide input in most or all of the other
aforementioned cells prior to Saving the workbook depending on the value of
cell C11.

I wrote the code shown below and put it in the ThisWorkbook object.
Unfortunately, upon testing, users are still able to Save the workbook
without all the required cells being populated.

Being somewhat of a novice with VBA, I would be very grateful if someone
could tell me where I have gone wrong with my code.

Thanks in advance for any assistance.

Bob

-----------------------

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

' This code checks to see that all required fields contain
' data before allowing the user to Save the workbook

Dim iCell As Variant

' Change Type = blank

If Sheets("CTI Change Request Form").Range("C11").Value = "" Then
Cancel = True
MsgBox "The workbook cannot be saved until a Change Type has
been selected.", _
vbCritical, "Missing Change Type!"
Sheets("CTI Change Request Form").Range("C11").Select
Exit Sub
End If

' Reason Category = blank

If Sheets("CTI Change Request Form").Range("C12").Value = "" Then
Cancel = True
MsgBox "The workbook cannot be saved until a Reason Category has
been selected.", _
vbCritical, "Missing Reason Category!"
Sheets("CTI Change Request Form").Range("C12").Select
Exit Sub
End If

' Change Type = ADD

If Sheets("CTI Change Request Form").Range("C11").Value = "ADD" Then
For Each iCell In Sheets("CTI Change Request
Form").Range("C9:C11,C13:C16")
If IsEmpty(Sheets("CTI Change Request Form").Range(iCell.Address))
Then
Cancel = True
MsgBox "The workbook cannot be saved until ALL fields have been
populated.", _
vbCritical, "Missing Required Data!"
Exit Sub
End If
Next iCell
End If

' Change Type = MOVE

If Sheets("CTI Change Request Form").Range("C11").Value = "MOVE" Then
For Each iCell In Sheets("CTI Change Request Form").Range("C9:C17")
If IsEmpty(Sheets("CTI Change Request Form").Range(iCell.Address))
Then
Cancel = True
MsgBox "The workbook cannot be saved until ALL fields have been
populated.", _
vbCritical, "Missing Required Data!"
Exit Sub
End If
Next iCell
End If

' Change Type = DROP, ON HOLD, CANCEL, or RE-START

If Sheets("CTI Change Request Form").Range("C11").Value = "DROP" Or _
Sheets("CTI Change Request Form").Range("C11").Value = "ON HOLD" Or _
Sheets("CTI Change Request Form").Range("C11").Value = "CANCEL" Or _
Sheets("CTI Change Request Form").Range("C11").Value = "RE-START" Then
For Each iCell In Sheets("CTI Change Request
Form").Range("C9:C13,C15:C17")
If IsEmpty(Sheets("CTI Change Request Form").Range(iCell.Address))
Then
Cancel = True
MsgBox "The workbook cannot be saved until ALL fields have been
populated.", _
vbCritical, "Missing Required Data!"
Exit Sub
End If
Next iCell
End If

' Change Type = REF. CHANGE and Reason Category = PAT ID changed

If Sheets("CTI Change Request Form").Range("C11").Value = "REF. CHANGE" And _
Sheets("CTI Change Request Form").Range("C12").Value = "PAT ID changed"
Then
For Each iCell In Sheets("CTI Change Request
Form").Range("C9:C13,C15:C17,E15")
If IsEmpty(Sheets("CTI Change Request Form").Range(iCell.Address))
Then
Cancel = True
MsgBox "The workbook cannot be saved until ALL fields have been
populated.", _
vbCritical, "Missing Required Data!"
Exit Sub
End If
Next iCell
End If

' Change Type = REF. CHANGE and Reason Category = PRISM ID changed

If Sheets("CTI Change Request Form").Range("C11").Value = "REF. CHANGE" And _
Sheets("CTI Change Request Form").Range("C12").Value = "PRISM ID changed"
Then
For Each iCell In Sheets("CTI Change Request
Form").Range("C9:C13,C15:C17,E16")
If IsEmpty(Sheets("CTI Change Request Form").Range(iCell.Address))
Then
Cancel = True
MsgBox "The workbook cannot be saved until ALL fields have been
populated.", _
vbCritical, "Missing Required Data!"
Exit Sub
End If
Next iCell
End If

' Change Type = REF. CHANGE and Reason Category = PAT and PRISM IDs changed

If Sheets("CTI Change Request Form").Range("C11").Value = "REF. CHANGE" And _
Sheets("CTI Change Request Form").Range("C12").Value = "PAT and PRISM IDs
changed" Then
For Each iCell In Sheets("CTI Change Request
Form").Range("C9:C13,C15:C17,E15:E16")
If IsEmpty(Sheets("CTI Change Request Form").Range(iCell.Address))
Then
Cancel = True
MsgBox "The workbook cannot be saved until ALL fields have been
populated.", _
vbCritical, "Missing Required Data!"
Exit Sub
End If
Next iCell
End If

End Sub