VBA to Copy Sheet Rename to Next weekday and Change date in New Sheet

[FSUrf02]

Hello,

Still very much a beginner at VBA. I typically can google what I want to do and copy/modify the code from different search results and make it work, but I'm having some difficulty doing that this time. I feel like what I need to do is simple enough so maybe I'm overthinking it, but any help would be greatly appreciated.

Essentially, I create a daily schedule in a worksheet within a workbook of a bunch of other old daily schedules. At the end of each day, I create a copy of today's schedule (current worksheet) and will manually update the tab's name to the next workday date we will work (which are almost always Monday-Friday). So for today (Friday, 9/16/22) I will be copying the tab labeled "Fri 9.16.2022", rename the copied worksheet to the next available business day which is Mon. 9.19.2022. Then I will go into that worksheet and will manually type the date at the top of the worksheet which is a merged cell (B1:O1) as 9/19/22. That cell is formatted so that it displays in the Long Date format (Monday, September 19, 2022). I don't necessarily want it to work on current date but the date in the current workbook as I don't want to be tied to the day we are creating the schedule.

So I want to create a a macro that I can tie to a button in the sheet that does those steps automatically.

Other particulars:

If possible, I would prefer to keep the formatting of the date on the worksheet as the abbreviation of the day (i.e. Mon, Tue, Wed, Thu, Fri) then the date in mm.dd.yyyy format so Mon 9.19.2022, but can live with whatever it can do.

Also, I know it's a bit unconventional, but I prefer the new worksheet to be inserted BEFORE the one we copied or to the left. So Mon 9.19.2022 is left of Fri 9.16.2022.

**Something that would be really nice would be create a message box pop up every time to ask the user to confirm the next weekday is the day they want to make the next schedule (I.e. "Create the schedule for Mon 9.19.2022? Y or N). If they select no, maybe allow them to input the date they want to create or just give the option up front? This would handle those instances where the next business date falls on a potential Holiday or if we need to create one on a weekend (which is fairly rare) or create multiple days ahead of time.

Again, any help would be greatly appreciated.

 

[mumps]

Try:

Sub CopyRenameSheet()
    Application.ScreenUpdating = False
    Dim sDate As String, rDate As Date, nextD As String, response As String
    sDate = Mid(ActiveSheet.Name, 5, 99)
    rDate = DateSerial(Split(sDate, ".")(2), Split(sDate, ".")(0), Split(sDate, ".")(1))
    nextD = Format(Application.WorkDay(rDate, 1), "ddd d.mm.yyyy")
    If MsgBox("Do you want to create the schedule for " & nextD & "?", vbYesNo) = vbYes Then
        ActiveSheet.Copy before:=ActiveSheet
        With ActiveSheet
            .Name = nextD
            .Range("B1") = Format(ActiveSheet.Name, "dddd d.mm.yyyy")
        End With
    Else
        response = InputBox("Please enter the desired date.")
        If response = "" Then Exit Sub
        If Not IsDate(response) Then
            MsgBox ("Invalid date.  Please try again")
            Exit Sub
        Else
            ActiveSheet.Copy before:=ActiveSheet
            With ActiveSheet
                .Name = Format(DateValue(response), "ddd d.mm.yyyy")
                .Range("B1") = ActiveSheet.Name
            End With
        End If
    End If
    Application.ScreenUpdating = True
End Sub

 

[FSUrf02]

Try:

Sub CopyRenameSheet()
    Application.ScreenUpdating = False
    Dim sDate As String, rDate As Date, nextD As String, response As String
    sDate = Mid(ActiveSheet.Name, 5, 99)
    rDate = DateSerial(Split(sDate, ".")(2), Split(sDate, ".")(0), Split(sDate, ".")(1))
    nextD = Format(Application.WorkDay(rDate, 1), "ddd d.mm.yyyy")
    If MsgBox("Do you want to create the schedule for " & nextD & "?", vbYesNo) = vbYes Then
        ActiveSheet.Copy before:=ActiveSheet
        With ActiveSheet
            .Name = nextD
            .Range("B1") = Format(ActiveSheet.Name, "dddd d.mm.yyyy")
        End With
    Else
        response = InputBox("Please enter the desired date.")
        If response = "" Then Exit Sub
        If Not IsDate(response) Then
            MsgBox ("Invalid date.  Please try again")
            Exit Sub
        Else
            ActiveSheet.Copy before:=ActiveSheet
            With ActiveSheet
                .Name = Format(DateValue(response), "ddd d.mm.yyyy")
                .Range("B1") = ActiveSheet.Name
            End With
        End If
    End If
    Application.ScreenUpdating = True
End Sub

Everything works great with the exception of the date format which I was able to fix to (want it to display mm.dd.yyyy) . The other thing that isn't working perfectly is the I would like the cell value in B1 to be the date 9/16/22 and no abbreviation of the day as the cell is formatted to where even when i enter 9/19/22 it displays as "Monday, September 19, 2022). Couldn't figure out how to alter your code above to make that happen. Here is what I modified so far to correct the date formatting. Everything else works brilliantly perfect! Thanks so much!

Sub Copyrenameworksheet()

   Sub CopyRenameSheet()
    Application.ScreenUpdating = False
    Dim sDate As String, rDate As Date, nextD As String, response As String
    sDate = Mid(ActiveSheet.Name, 5, 99)
    rDate = DateSerial(Split(sDate, ".")(2), Split(sDate, ".")(0), Split(sDate, ".")(1))
    nextD = Format(Application.WorkDay(rDate, 1), "ddd mm.dd.yyyy")
    If MsgBox("Do you want to create the schedule for " & nextD & "?", vbYesNo) = vbYes Then
        ActiveSheet.Copy before:=ActiveSheet
        With ActiveSheet
            .Name = nextD
            .Range("B1") = Format(ActiveSheet.Name, "mm.dd.yyyy")
        End With
    Else
        response = InputBox("Please enter the desired date.")
        If response = "" Then Exit Sub
        If Not IsDate(response) Then
            MsgBox ("Invalid date.  Please try again")
            Exit Sub
        Else
            ActiveSheet.Copy before:=ActiveSheet
            With ActiveSheet
                .Name = Format(DateValue(response), "ddd mm.dd.yyyy")
                .Range("B1") = ActiveSheet.Name
            End With
        End If
    End If
    Application.ScreenUpdating = True
End Sub

 

[mumps]

Try:

Sub CopyRenameSheet()
    Application.ScreenUpdating = False
    Dim sDate As String, rDate As Date, nextD As String, response As String
    sDate = Mid(ActiveSheet.Name, 5, 99)
    rDate = DateSerial(Split(sDate, ".")(2), Split(sDate, ".")(0), Split(sDate, ".")(1))
    nextD = Format(Application.WorkDay(rDate, 1), "ddd mm.dd.yyyy")
    If MsgBox("Do you want to create the schedule for " & nextD & "?", vbYesNo) = vbYes Then
        ActiveSheet.Copy before:=ActiveSheet
        With ActiveSheet
            .Name = nextD
            .Range("B1") = Format(Mid(ActiveSheet.Name, 5, 99), "mm/dd/yyyy")
        End With
    Else
        response = InputBox("Please enter the desired date.")
        If response = "" Then Exit Sub
        If Not IsDate(response) Then
            MsgBox ("Invalid date.  Please try again")
            Exit Sub
        Else
            ActiveSheet.Copy before:=ActiveSheet
            With ActiveSheet
                .Name = Format(DateValue(response), "ddd mm.dd.yyyy")
                .Range("B1") = Format(Mid(ActiveSheet.Name, 5, 99), "mm/dd/yyyy")
            End With
        End If
    End If
    Application.ScreenUpdating = True
End Sub

 

[FSUrf02]

Try:

Sub CopyRenameSheet()
    Application.ScreenUpdating = False
    Dim sDate As String, rDate As Date, nextD As String, response As String
    sDate = Mid(ActiveSheet.Name, 5, 99)
    rDate = DateSerial(Split(sDate, ".")(2), Split(sDate, ".")(0), Split(sDate, ".")(1))
    nextD = Format(Application.WorkDay(rDate, 1), "ddd mm.dd.yyyy")
    If MsgBox("Do you want to create the schedule for " & nextD & "?", vbYesNo) = vbYes Then
        ActiveSheet.Copy before:=ActiveSheet
        With ActiveSheet
            .Name = nextD
            .Range("B1") = Format(Mid(ActiveSheet.Name, 5, 99), "mm/dd/yyyy")
        End With
    Else
        response = InputBox("Please enter the desired date.")
        If response = "" Then Exit Sub
        If Not IsDate(response) Then
            MsgBox ("Invalid date.  Please try again")
            Exit Sub
        Else
            ActiveSheet.Copy before:=ActiveSheet
            With ActiveSheet
                .Name = Format(DateValue(response), "ddd mm.dd.yyyy")
                .Range("B1") = Format(Mid(ActiveSheet.Name, 5, 99), "mm/dd/yyyy")
            End With
        End If
    End If
    Application.ScreenUpdating = True
End Sub

The date in Cell B1 is still showing up as 09.19.2022 instead of the desired 9/19/2022 (which would show up as "Monday, September 19, 2022"). I've tried everything I know to try to modify your code but still can't get it (I know it is something probably pretty easy but I'm dense - lol). Thanks again for all your help.

 

[FSUrf02]

Ok, got one thing figured out but now, when I test the prompt when I click "No" on the message and type another date say 9.17.2022, it returns a date of Saturday 12/30/1899. Here is my revised code to try to fix the date format in B1 but again, everything seems to work besides when you click No and enter your own date.

Sub Copyrenameworksheet()

   Sub CopyRenameSheet()
    Application.ScreenUpdating = False
    Dim sDate As String, rDate As Date, nextD As String, response As String
    sDate = Mid(ActiveSheet.Name, 5, 99)
    rDate = DateSerial(Split(sDate, ".")(2), Split(sDate, ".")(0), Split(sDate, ".")(1))
    nextD = Format(Application.WorkDay(rDate, 1), "ddd. mm.dd.yyyy")
    nextD2 = Format(Application.WorkDay(rDate, 1), "mm/dd/yyyy")
    If MsgBox("Do you want to create the schedule for " & nextD & "?", vbYesNo) = vbYes Then
        ActiveSheet.Copy before:=ActiveSheet
        With ActiveSheet
            .Name = nextD
            .Range("B1") = nextD2
        End With
    Else
        response = InputBox("Please enter the desired date.")
        If response = "" Then Exit Sub
        If Not IsDate(response) Then
            MsgBox ("Invalid date.  Please try again")
            Exit Sub
        Else
            ActiveSheet.Copy before:=ActiveSheet
            With ActiveSheet
                .Name = Format(DateValue(response), "ddd mm.dd.yyyy")
                .Range("B1") = Format(DateValue(response), "mm/dd/yyyy")
            End With
        End If
    End If
    Application.ScreenUpdating = True
End Sub

 

[mumps]

Try entering the date in yyyy/mm/dd format.

 

[FSUrf02]

Try entering the date in yyyy/mm/dd format.

Yep, that seems to work. Using that same code I posted in my last post but entering a date in the yyyy/mm/dd format fixed it all but I know no one is going to like having to enter it that way. Any way to write the code so that it will work when entering 9/17/22 or even 9/17/2022 to "fool proof" it? If not, I will take just 9/17/22. It's so close! Thanks!

 

[FSUrf02]

Ok, think I figured it out. Seems to be working now. This was my code if there are other interested parties

Sub CopyRenameSheet()
    Application.ScreenUpdating = False
    Dim sDate As String, rDate As Date, nextD As String, nextD2 As String, response As String
    sDate = Mid(ActiveSheet.Name, 5, 99)
    rDate = DateSerial(Split(sDate, ".")(2), Split(sDate, ".")(0), Split(sDate, ".")(1))
    nextD = Format(Application.WorkDay(rDate, 1), "ddd mm.dd.yyyy")
    nextD2 = Format(Application.WorkDay(rDate, 1), "mm/dd/yyyy")
    If MsgBox("Do you want to create the schedule for " & nextD & "?", vbYesNo) = vbYes Then
        ActiveSheet.Copy before:=ActiveSheet
        With ActiveSheet
            .Name = nextD
            .Range("B1") = nextD2
        End With
    Else
        response = Format(response, "mm/dd/yyyy")
        response = InputBox("Please enter the desired date in mm/dd/yyyy format")
        If response = "" Then Exit Sub
                If Not IsDate(response) Then
            MsgBox ("Invalid date.  Please try again")
            Exit Sub
        Else
            ActiveSheet.Copy before:=ActiveSheet
            With ActiveSheet
                .Name = Format(DateValue(response), "ddd mm.dd.yyyy")
                .Range("B1") = Format(DateValue(response), "mm/dd/yyyy")
            End With
        End If
    End If
    Application.ScreenUpdating = True
End Sub