I have a functional code, however it now requires one more criteria. I need 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, I need 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.
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