How to End Macro if cell is blank, continue if populated

How to end Macro if cell is blank, continue if populated

Requirement:

The user has a functional code, however it now requires one more criteria.

The user needs to check at the beginning of this code to determine if cell I1 (on "Main", codename sheet2) is populated.

This cell contains a date that is used in the renaming of the sheet tabs s well as the actual workbook. If I1 is blank, the user needs the macro to display a message box stating "Please enter the Payroll Date into cellI1", and the code should be exited. Now if cell I1 contains a date, then the macro should run.

Code:

Sub Save_Seperate_Sheets()

' Saves multiple sheets in another workbook based on the cell values
Dim fName As String         ' Output File Name
Dim Path1 As String         ' Path name (current directory)
Dim xlD As Workbook         ' Output file
Dim xlS As Workbook         ' THIS workbook
Dim shS As Worksheet        ' Worksheets in current workbook

' Optimize Macro Speed
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual

Path1 = ThisWorkbook.Path
fName = Sheets("Main").Range("$C$4") & " " & Format(Sheets("Main").Range("$I$1"), "mm.dd.yy") & ".xlsx"
Set xlS = ThisWorkbook

' Rename sheets
    Call RenameSheets
    
' Create the new workbook
    Set xlD = Workbooks.Add

' Copy sheets in
    For Each shS In xlS.Sheets
        If shS.Name <> "Main" Then
            shS.Copy after:=xlD.Sheets(Sheets.Count)
            xlD.Sheets(Sheets.Count).Name = shS.Name
        End If
    Next shS

' Remove the superfluous sheets
    xlD.Sheets(1).Delete ' <!-- Removes sheet1 (Main)

' Hide the code sheet
    xlD.Sheets("codes").Visible = xlHidden
     
' Save the workbook
    xlD.SaveAs FileName:=Path1 & "\" & fName, FileFormat:=51

' Rename Sheet3 & Sheet4 back to default
' Call the RenameSheetsReset macro
    Call RenameSheetsReset

'Close the workbook
    xlD.save

ResetSettings:
' Reset Macro Optimization Settings
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
   xlS.Close True ' <!--- ' THIS workbook

End Sub

https://www.ozgrid.com/forum/forum/help-forums/excel-vba-macros/1217972-end-macro-if-cell-is-blank-continue-if-populated

Solution:

Code:

Sub Save_Separate_Sheets()

' Saves multiple sheets in another workbook based on the cell values

Dim fName As String         ' Output File Name
Dim Path1 As String         ' Path name (current directory)
Dim xlD As Workbook         ' Output file
Dim xlS As Workbook         ' THIS workbook
Dim shS As Worksheet        ' Worksheets in current workbook

' New Test for cell I1 ... Is there a date ?
If Not VBA.IsDate(Sheets("Main").Range("I1")) Then MsgBox " Please Enter the Payroll Date into cell I1": Exit Sub

' Optimize Macro Speed
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual

Path1 = ThisWorkbook.Path
fName = Sheets("Main").Range("$C$4") & " " & Format(Sheets("Main").Range("$I$1"), "mm.dd.yy") & ".xlsx"
Set xlS = ThisWorkbook

' Rename sheets
    Call RenameSheets
    
' Create the new workbook
    Set xlD = Workbooks.Add

' Copy sheets in
    For Each shS In xlS.Sheets
        If shS.Name <> "Main" Then
            shS.Copy after:=xlD.Sheets(Sheets.Count)
            xlD.Sheets(Sheets.Count).Name = shS.Name
        End If
    Next shS

' Remove the superfluous sheets
    xlD.Sheets(1).Delete ' <!-- Removes sheet1 (Main)

' Hide the code sheet
    xlD.Sheets("codes").Visible = xlHidden
     
' Save the workbook
    xlD.SaveAs Filename:=Path1 & "\" & fName, FileFormat:=51

' Rename Sheet3 & Sheet4 back to default
' Call the RenameSheetsReset macro
    Call RenameSheetsReset

'Close the workbook
    xlD.Save

ResetSettings:
' Reset Macro Optimization Settings
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
   xlS.Close True ' <!--- ' THIS workbook

End Sub

Obtained from the OzGrid Help Forum.

Solution provided by Carim.