Code to Implement Required Cells Not Working

[Bob]

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

 

[JLatham]

Bob, I took the liberty of revising your code to use Select Case instead of
all of the IF..Then statements, and also added an object to assign as that
worksheet (mostly for brevity of code lines).

The testing all pre-processes the C11/C12 values by removing any leading or
trailing blanks from them and converting them to all UPPERCASE for more
positive testing. For example, when you test them for = "", it may be that
one or the other actually contains " ", in which case your test would fail.
With Trim() it won't.

Make a copy of your workbook and replace the code in it with the code below
and see how it goes. Watch out for line-wraps; after copying your code from
your posting I had to do a bit of fixing up from all the damage the system
here did to it, and I'm sure it'll repeat that again. I tried to shorten
them up enough to where it won't, but it often fools me.

I also added a couple of Case Else statements that will report to you when
the value of either C11 or C12 is not any of the tested values. I presume
you have coded this to cover all valid entries in C11 and C12, so this would
help if you forgot one or there's a typo involved in things.


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
Dim ctiSheet As Worksheet

Set ctiSheet = _
ThisWorkbook.Worksheets("CTI Change Request Form")

'moved to the top since we only have one thing to
'consider if C12 is blank/empty
' the Trim() will make sure that a single space
' in the cell doesn't fool your testing
' Reason Category = blank
If Trim(ctiSheet.Range("C12").Value) = "" Then
Cancel = True
MsgBox "The workbook cannot be saved until " & _
"a Reason Category has been selected.", _
vbCritical, "Missing Reason Category!"
ctiSheet.Range("C12").Select
Set ctiSheet = Nothing ' housekeeping
Exit Sub
End If

'use Select Case for now to help visualize process and
'values that C11 may take
' UCase and Trim will make sure that certain typos
' won't affect the results
Select Case UCase(Trim(ctiSheet.Range("C11")))
Case Is = ""
' Change Type = blank
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

Case Is = "ADD"
' Change Type = ADD
For Each iCell In ctiSheet.Range("C9:C11,C13:C16")
If IsEmpty(ctiSheet.Range(iCell.Address)) Then
Cancel = True
MsgBox "The workbook cannot be saved until ALL " & _
"fields have been populated.", _
vbCritical, "Missing Required Data!"
End If
Next iCell

Case Is = "MOVE"
' Change Type = MOVE
For Each iCell In ctiSheet.Range("C9:C17")
If IsEmpty(ctiSheet.Range(iCell.Address)) Then
Cancel = True
MsgBox "The workbook cannot be saved until ALL " & _
"fields have been populated.", _
vbCritical, "Missing Required Data!"
End If
Next iCell

Case Is = "DROP", "ON HOLD", "CANCEL RE-START"
' Change Type = DROP, ON HOLD, CANCEL, or RE-START
For Each iCell In ctiSheet.Range("C9:C13,C15:C17")
If IsEmpty(ctiSheet.Range(iCell.Address)) Then
Cancel = True
MsgBox "The workbook cannot be saved until ALL " & _
"fields have been populated.", _
vbCritical, "Missing Required Data!"
End If
Next iCell

Case Is = "REF. CHANGE"
' Change Type = REF. CHANGE also check Reason Category
'and Reason Category = PAT ID changed
Select Case UCase(Trim(ctiSheet.Range("C12")))
Case Is = "PAT ID CHANGED" ' all UPPER CASE
'Reason Category = PAT ID changed
For Each iCell In ctiSheet.Range("C9:C13,C15:C17,E15")
If IsEmpty(ctiSheet.Range(iCell.Address)) Then
Cancel = True
MsgBox "The workbook cannot be saved until ALL " & _
"fields have been populated.", _
vbCritical, "Missing Required Data!"
End If
Next iCell

Case Is = "PRISM ID CHANGED"
'Reason Category = PRISM ID changed
For Each iCell In ctiSheet.Range("C9:C13,C15:C17,E16")
If IsEmpty(ctiSheet.Range(iCell.Address)) Then
Cancel = True
MsgBox "The workbook cannot be saved until ALL " & _
"fields have been populated.", _
vbCritical, "Missing Required Data!"
End If
Next iCell

Case Is = "PAT AND PRISM IDS CHANGED"
'Reason Category = PAT and PRISM IDs changed
For Each iCell In ctiSheet.Range("C9:C13,C15:C17,E15:E16")
If IsEmpty(ctiSheet.Range(iCell.Address)) Then
Cancel = True
MsgBox "The workbook cannot be saved until ALL " & _
"fields have been populated.", _
vbCritical, "Missing Required Data!"
End If
Next iCell

Case Else
'this assumes that all possible valid cases for C12
'have been tested previously
MsgBox "Change Type entry is not any expected entry!", _
vbCritical, "C11 Has Unexpected Value"
Cancel = True

End Select ' end Reason Category Tests

Case Else
'this assumes that all possible valid cases for C11
'have been tested previously
MsgBox "Change Type entry is not any expected entry!", _
vbCritical, "C11 Has Unexpected Value"
Cancel = True
End Select
'housekeeping
Set ctiSheet = Nothing

End Sub

 

[Bob]

JLatham, Wow! I did not expect you (and I wasn't looking for anyone) to
re-write the entire code block. Thanks a million!!! I sincerely appreciate
it.

Had I known you were going to do this, I would have also mentioned in my
post that C11 and C12 contain Data Validation Lists. Furthermore, the
choices displayed in C12 automatically change depending on the choice
selected in C11.

Thanks again for all your help!

Regards,
Bob

 

[Bob]

JLatham, after I replaced my code with yours, I noticed that if I attempt to
Save the workbook when some of the fields are still blank, the display of the
message box loops "x" times (where "x" = number of remaining empty fields).
In other words, if I input a value only in cell C11, the message box
continues to be displayed until I have clicked the OK button 8 times.

Could you please tell me how to fix this?

Thanks again.

Regards,
Bob