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

F

FSUrf02

New Member
Joined
Apr 5, 2012
Messages
7
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.
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
Sort by date Sort by votes
Try:
VBA Code: 
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
 
Upvote 0
mumps said:
Try:
VBA Code: 
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
Click to expand...
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!

VBA Code: 
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
 
Upvote 0
Try:
VBA Code: 
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
 
Upvote 0
mumps said:
Try:
VBA Code: 
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
Click to expand...
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.
 
Upvote 0
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.

VBA Code: 
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
 
Upvote 0
Try entering the date in yyyy/mm/dd format.
 
Upvote 0
mumps said:
Try entering the date in yyyy/mm/dd format.
Click to expand...
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!
 
Upvote 0
Ok, think I figured it out. Seems to be working now. This was my code if there are other interested parties

VBA Code: 
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
 
Upvote 0
You must log in or register to reply here.

Similar threads

franklin_m
  • Question
VBA Search row for instances of pattern in two adjacent cells
Replies
3
Views
117
franklin_m
franklin_m
J
  • Question
Formula for weekdays of date in another cell
Replies
4
Views
469
Jaxi
J
S
  • Solved
WORKDAY.INTL does not block out holidays
2
Replies
13
Views
543
shawnbull
S
G
  • Question
Autoupdate date
Replies
3
Views
161
kevin9999
K
A
  • Question
Auto Update Sheets in Scheduler file
Replies
6
Views
279
anuradhagrewal
A

Forum statistics

Threads
1,214,952
Messages
6,122,458
Members
449,085
Latest member
ExcelError

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top