Change Cell Value after being copied by macro - vba

Question

Download for Sheet to better understand.
https://www.dropbox.com/s/urncoww8prj6rc1/AccountabilityScorecardDigital.xlsm?dl=0
I am creating a workbook that has auto-creating sheets. Each sheet has the same data with the exception of the dates. I simply need the one cell "A1" to auto-change it's name to the next date range.
For Example: Sheet1 Cell A1 "DEC 11-15 2017"
Copied : Sheet2 Cell A1 "Dec 18-22 2017"
Copied2 : Sheet3 Cell A1 "Dec 25-29 2017"
Copied3 : Sheet4 Cell A1 "Jan 01-05 2017"
It has to follow this naming convention so that the rest of the sheet updates accordingly.

Answer 1

Here you go.
Just use the GetProperWeekName function and feed it whatever you want.
For example, GetProperWeekName("DEC 11-15 2017", 7)
Will Return:
DEC 18-22 2017
You can add days, months, or years by using the optional parameters.
To add a week, you would use 7 as I did in my example.
When you create your new sheet, just update A1 by doing something like:
Range("A1") = GetProperWeekName(Range("A1"),7)
Function GetProperWeekName(TheWeek As Variant, Optional DaysToAdd = 0, Optional MonthsToAdd = 0, Optional YearsToAdd = 0) As String
Dim TheDate As Date
TheDate = DateValue(Trim(Left(TheWeek, WorksheetFunction.Find("-", TheWeek) - 1)))
If DaysToAdd <> 0 Then TheDate = DateAdd("d", DaysToAdd, TheDate)
If MonthsToAdd <> 0 Then TheDate = DateAdd("m", MonthsToAdd, TheDate)
If YearsToAdd <> 0 Then TheDate = DateAdd("y", YearsToAdd, TheDate)
GetProperWeekName = UCase(Format(TheDate, "mmm")) & " " & Day(TheDate) & "-" & Day(DateAdd("d", 4, TheDate)) & " " & Year(TheDate)
End Function
Results:
If you want it to accept normal dates and format them, it's easier:
Function GetProperWeekName(TheDate As Date, Optional DaysToAdd = 0, Optional MonthsToAdd = 0, Optional YearsToAdd = 0) As String
If DaysToAdd <> 0 Then TheDate = DateAdd("d", DaysToAdd, TheDate)
If MonthsToAdd <> 0 Then TheDate = DateAdd("m", MonthsToAdd, TheDate)
If YearsToAdd <> 0 Then TheDate = DateAdd("y", YearsToAdd, TheDate)
GetProperWeekName = UCase(Format(TheDate, "mmm")) & " " & Day(TheDate) & "-" & Day(DateAdd("d", 4, TheDate)) & " " & Year(TheDate)
End Function
How to update your sheet and date ranges properly:
Sub UpdateSheet()
ActiveSheet.Copy After:=Sheets(ActiveSheet.Name)
ActiveSheet.Name = GetProperWeekName(Range("A1"), 7)
Range("A1") = GetProperWeekName(Range("A1"), 7)
End Sub
QHarr's Padding Addition:
Function GetProperWeekName(TheWeek As Variant, Optional DaysToAdd = 0, Optional MonthsToAdd = 0, Optional YearsToAdd = 0) As String
Dim TheDate As Date
TheDate = DateValue(Trim(Left(TheWeek, WorksheetFunction.Find("-", TheWeek) - 1)))
If DaysToAdd <> 0 Then TheDate = DateAdd("d", DaysToAdd, TheDate)
If MonthsToAdd <> 0 Then TheDate = DateAdd("m", MonthsToAdd, TheDate)
If YearsToAdd <> 0 Then TheDate = DateAdd("y", YearsToAdd, TheDate)
GetProperWeekName = UCase(Format(TheDate, "mmm")) & " " & Format(Day(TheDate), "00") & "-" & Format(Day(DateAdd("d", 4, TheDate)), "00") & " " & Year(TheDate)
End Function