Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Code to Implement Required Cells Not Working
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Code to Implement Required Cells Not Working
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" wrote: 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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Code to Implement Required Cells Not Working
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 "JLatham" wrote: 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" wrote: 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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Code to Implement Required Cells Not Working
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 "JLatham" wrote: 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" wrote: 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
format cells as zip code not working | Excel Discussion (Misc queries) | |||
implement vlookup formula to VBA code | Excel Programming | |||
Search cells code not working | Excel Programming | |||
Can you implement a custom format with VB code? | Excel Programming | |||
Using a collection class to implement mutliple find/replace strings in cells | Excel Programming |