macro to copy and rename workbook to today's date plus 1 day if existing

[miming1986]

Sub NewPage()

Sheets("Master").Visible = True
Sheets("Master").Copy After:=Worksheets(Worksheets.Count)
NewPageName = Format(Date, "mmdd")
ActiveWindow.ActiveSheet.Name = NewPageName
Sheets("Master").Visible = False
Range("B3").Select

End Sub

This code will copy my MASTER sheet, rename it to today's date in "mmdd" format and places it after the last sheet.

What if I run the macro a second, or third time etc. on the same day, since there can't be 2 sheets with the same name in a workbook, i am considering adding 1 day from today's date (if possible excluding weekends - Saturday and Sunday). If this is not doable, i'm thinking of having a msgbox if the macro is run again on the same day to display something like "you're too early for tomorrow's shift".

 

[miming1986]

Sub NewPage()
On Error GoTo EH
Sheets("Master").Visible = True
Sheets("Master").Copy After:=Worksheets(Worksheets.Count)
NewPageName = Format(Date, "mmdd")
ActiveWindow.ActiveSheet.Name = NewPageName
Sheets("Master").Visible = False
Range("B3").Select
Exit Sub
EH:
Sheets("Master").Visible = False
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
MsgBox "You're too early for tomorrow!", , "Oppss"
End Sub

I managed to have the msgbox to prompt if the macro is run more than once on the same day thru an On Error. However, i just hope that adding of 1 day from today's date (excluding weekends) is doable. Thanks!

 

[Kenneth Hobson]

While one could do that, it might be better to check if worksheet exists?

Sub Test_WorkSheetExists()
  MsgBox "WorksheetExists? " & WorkSheetExists("Sheet1"), _
    vbInformation, "ActiveWorkbook.ActiveSheet"
   
  MsgBox "WorksheetExists? " & WorkSheetExists("ken", "ken.xlsm"), _
    vbInformation
End Sub

'WorkSheetExists in a workbook:
Function WorkSheetExists(sWorkSheet As String, Optional sWorkbook As String = "") As Boolean
    Dim ws As Worksheet, wb As Workbook
    On Error GoTo notExists
    If sWorkbook = "" Then
      Set wb = ActiveWorkbook
      Else
      Set wb = Workbooks(sWorkbook) 'sWorkbook must be open already.  e.g. ken.xlsm, not x:\ken.xlsm.
    End If
    Set ws = wb.Worksheets(sWorkSheet)
    WorkSheetExists = True
    Exit Function
notExists:
    WorkSheetExists = False
End Function

 

[Marc L]

Hi !

Others functions already published in this forum :

• ExistSheet

• ExistWorkbookSheet …
​