Prevent Save, if field is blank

I need a macro built for this spreadsheet.

There are three columns:
 1. Job Family (F)
 2. Discipline (G)
 3. Subdiscipline (H)

Discipline and SubDiscipline have a cascading dropdown list that's driven by the Job Family that's selected.

I need two things to happen with this spreadsheet

1. If a discipline is selected, but the subdiscipline is blank, not allow the file to save.  

Popup message, "You must select a Subdiscipline before saving the file.

2.  If someone selects a discipline and a subdiscipline, but decides to change the discipline, I need the subdiscipline to blank out.  (If not, then the subdiscipline will remain as previously selected.)

All this data will be loaded into SAP and these are the rules in SAP, so we want to have the data as clean as possible for the upload, else, the records will error out.
Discipline-and-Subdiscipline--sa.xlsx
ablove3Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

[ fanpages ]IT Services ConsultantCommented:
Hi,

The following code is taken from the attached workbook's code module for the [Incomplete] worksheet:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

  On Error Resume Next

  If Not (Intersect(Target, Range([G2], Cells(Cells(Rows.Count, "F").End(xlUp).Row, "G"))) Is Nothing) Then
     Application.EnableEvents = False
     Cells(Target.Row, "H").ClearContents
  End If
  
  Application.EnableEvents = True
  
End Sub

Open in new window


Additionally, the following code is taken from the "ThisWorkbook" ("wbkQ_28241687") code module:

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

  Dim objCell                                           As Range
  
  On Error Resume Next
  
  For Each objCell In Worksheets("Incomplete").Range([G2], Worksheets("Incomplete").Cells(Worksheets("Incomplete").Cells(Rows.Count, "F").End(xlUp).Row, "G"))
  
      If Len(Trim$(objCell)) > 0 Then
         If Len(Trim$(objCell.Offset(, 1))) = 0 Then
            objCell.Offset(, 1).Select
            MsgBox "You must select a Subdiscipline before saving the file", _
                   vbExclamation Or vbOKOnly, _
                   ThisWorkbook.Name
            Cancel = True
            Exit For
         End If ' If Len(Trim$(objCell.Offset(, 1))) = 0 Then
      End If ' If Len(Trim$(objCell)) > 0 Then

  Next objCell
  
  Set objCell = Nothing
  
End Sub

Open in new window


Please review the changes I have made (most notably, changing the file format from a ".xlsx" file extension to one that can support Visual Basic for Applications code; ".xlsm") & let me know if these meet your requirements.

Thank you.

BFN,

fp.
Q-28241687.xlsm
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
ablove3Author Commented:
Hi, I'm so sorry for responding so late.  It looks good, but the one thing I don't see, if how to blank out the Subdiscipline if another discipline is selected.
0
[ fanpages ]IT Services ConsultantCommented:
Hi,

The code to do that is within the code module for the "Incomplete" worksheet; the first of the two code blocks I posted above.

Unless you are saying that this is not working when you tried using the workbook I provided.

Thank you for your clarification.

BFN,

fp.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.