Prevent Saving if Specific Cell is Blank

[Jones1413]

Hello,

I have the below code in blue to prevent the workbook from being saved if a specific cell is blank. I also want it to loop through and require cells B5, B7, B9, B11, B13, B14, B15 & B16 to have text. How can I include those cells without writing individual If statements for each cell?

The code in red is attached to a Button in the worksheet to automatically go to SaveAs and once it is saved, it opens an Outlook e-mail with the document attached. If all of the required cells don't have data in them, I don't want it to open an e-mail with the document attached. It will currently still attach the document to an e-mail even if the document is not saved.

Sub SaveAs1()

If Application.Sheets("Staffing Justification Intake").Range("B3").Value = "" Then
Cancel = True
MsgBox "Required Information Missing"
End If

Dim FilenameSaveAs As String


FilenameSaveAs = Application.GetSaveAsFilename(InitialFileName:=ThisWorkbook.Worksheets("Staffing Justification Intake").Range("B9"), fileFilter:="Microsoft Excel Macro-Workbook (*.xlsm), *.xlsm")
If FilenameSaveAs <> "False" Then
ActiveWorkbook.SaveAs Filename:=FilenameSaveAs, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Else
MsgBox "File not saved", vbInformation, "Saving Cancelled"
End If

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "New Requisition Request"
.Attachments.Add ActiveWorkbook.FullName
.Body = "Hi ,"
.Display
'.Send you can send the email without even looking at it
End With

Set OutMail = Nothing
Set OutApp = Nothing
Exit Sub

End Sub

 

[GWteB]

Try this

Sub Example()
    
    Dim OutApp          As Object
    Dim OutMail         As Object
    Dim FilenameSaveAs  As String
    Dim c               As Range
    
    For Each c In ThisWorkbook.Sheets("Staffing Justification Intake").Range("B3, B5, B7, B9, B11, B13, B14, B15, B16")
        If c.Value = "" Then
            GoTo SUB_MISSING
        End If
    Next c
    
    FilenameSaveAs = Application.GetSaveAsFilename(InitialFileName:=ThisWorkbook.Worksheets("Staffing Justification Intake").Range("B9"), _
                                                   FileFilter:="Microsoft Excel Macro-Workbook (*.xlsm), *.xlsm")
    If FilenameSaveAs <> "False" Then
        ActiveWorkbook.SaveAs Filename:=FilenameSaveAs, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    Else
        MsgBox "File not saved", vbInformation, "Saving Cancelled"
    End If
    
    If ThisWorkbook.Saved Then
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
        OutApp.Visible = True
        With OutMail
            .To = ""
            .CC = ""
            .BCC = ""
            .Subject = "New Requisition Request"
            .Attachments.Add ActiveWorkbook.FullName
            .Body = "Hi ,"
            .Display
            '.Send 'you can send the email without even looking at it
        End With
        Set OutMail = Nothing
        Set OutApp = Nothing
    End If
    
    GoTo SUB_QUIT
    
SUB_MISSING:
    Set c = Nothing
    MsgBox "Required Information Missing"
    
SUB_QUIT:
End Sub