Changing tab names dynamically

[Grade4.2]

Hi there, I'm looking for help on solving an issue I can't use the macro recorder for but I know I'm in the right place.

- I have a tab named a date which always falls on a monday ie. "9 July"
- I need to copy this sheet over but rename itself 7 days after the most recent date that always falls on a monday ie. "16 July"

Any help would be muchly appreciated.

[mattreingold]

Hi Grade4.2, with the example provided, the below should work. I wasnt sure if the table was in the right place, thus you many need to adjust the "clear contents" range. Also, the sheet copying may throw off formulas if you don't have '$' notation to keep them from adjusting, I couldn't tell if this was the case with the example provided.

Also, this doesn't account for the month changing, you would need to add an if statement to check for that. This simply compounds the date by adding 7.

Anyway, this should work for you:

Sub CopyAndClear()
    Dim WBT As Workbook ' This workbook
    Set WBT = ThisWorkbook
    Dim newSheet As Worksheet ' Sheet being created
    Dim copySheet As Worksheet ' Sheet being copied
    Set copySheet = WBT.Sheets(1)
    Dim previousSheetName As String, previousSheetSplit() As String, monthFound As String, previousDate As Integer
    
    copySheet.Copy After:=WBT.Sheets(Sheets.Count) ' Copies to last sheet
    'WBT.Sheets(Sheets.Count).Name = InputBox("New Name:")
    Set newSheet = WBT.Sheets(Sheets.Count) ' Sets variable new sheet
    
    previousSheetSplit() = Split(WBT.Sheets(WBT.Sheets.Count - 1).Name, " ") ' Splits second to last sheets name, if it is the one to be modified?
    monthFound = previousSheetSplit(1) ' Second to last sheet's month (assuming it is the most recent one????)
    previousDate = previousSheetSplit(0) ' Previous date
    newSheet.Name = previousDate + 7 & " " & monthFound

    'Clears contents of original sheet (if this is the right range? modify if needed)
    copySheet.Range("Q8:AB25").ClearContents
    
End Sub

Please come back if you need anything tweaked/adjusted!

[Grade4.2]

This is really good!

After some testing though, I found that when making multiple sheets, I get the date 9 july 16 july 23 july 30 july 37 july 44 july etc. Are you able tweak this so it creates ongoing dates? ie. 9-16-23-30 july then ..... 6th august, 13 august etc? I don't know how you achieved this but I'm trying to understand by following through it slowly.

[mattreingold]

This changes months, this should account for each month's length - however it keeps triggering on the first if and I cannot figure out why...
(I.E. for some reason - this code assumes every month is 31 days in length, and it shouldn't).

This is super thrown together and could be done more eloquently, but I don't have a lot of time at the moment, so I figured I'd update you with this, and maybe someone can figure out whats wrong with the if statements and why the first one always triggers... (I tried string, int, all comparisons... something wrong with the or's...)

Anyway,

Sub CopyAndClear()
    Dim WBT As Workbook ' This workbook
    Set WBT = ThisWorkbook
    Dim newSheet As Worksheet ' Sheet being created
    Dim copySheet As Worksheet ' Sheet being copied
    Set copySheet = WBT.Sheets(1)
    Dim previousSheetName As String, previousSheetSplit() As String, monthFound As String, previousDate As Integer, nameHolder As String
    Dim monthsArray() As Variant
    
    ' Array of the months
    monthsArray = Array("January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December")


    ' Copy sheet
    copySheet.Copy After:=WBT.Sheets(Sheets.Count) ' Copies to last sheet
    Set newSheet = WBT.Sheets(Sheets.Count) ' Sets variable new sheet
    
    previousSheetSplit() = Split(WBT.Sheets(WBT.Sheets.Count - 1).Name, " ") ' Splits second to last sheets name, if it is the one to be modified?
    monthFound = previousSheetSplit(1) ' Second to last sheet's month (assuming it is the most recent one????)
    previousDate = previousSheetSplit(0) ' Previous date
    
    ' Matches current month to the index in the array of months
    Dim i As Long, monthIndex As Long
    monthIndex = 0
    For i = 0 To 11
        If monthFound = monthsArray(i) Then
            monthIndex = i
        End If
    Next i


    ' Checks if month/day needs to be wrapped for a new month
    If monthIndex = 0 Or 2 Or 4 Or 6 Or 7 Or 9 Or 11 Then
        If previousDate > 24 Then
            If monthIndex = 11 Then
                monthIndex = 0
            Else
                monthIndex = monthIndex + 1
            End If
            If previousDate = 25 Then
                newSheet.Name = 1 & " " & monthsArray(monthIndex)
            ElseIf previousDate = 26 Then
                newSheet.Name = 2 & " " & monthsArray(monthIndex)
            ElseIf previousDate = 27 Then
                newSheet.Name = 3 & " " & monthsArray(monthIndex)
            ElseIf previousDate = 28 Then
                newSheet.Name = 4 & " " & monthsArray(monthIndex)
            ElseIf previousDate = 29 Then
                newSheet.Name = 5 & " " & monthsArray(monthIndex)
            ElseIf previousDate = 30 Then
                newSheet.Name = 6 & " " & monthsArray(monthIndex)
            ElseIf previousDate = 31 Then
                newSheet.Name = 7 & " " & monthsArray(monthIndex)
            Else
                MsgBox ("Could not assign date appropriately, please manually fix.")
            End If
        ElseIf previousDate <= 24 Then
            newSheet.Name = previousDate + 7 & " " & monthsArray(monthIndex)
        End If
    ElseIf monthIndex = 3 Or 5 Or 8 Or 10 Then
        If previousDate > 23 Then
            If monthIndex = 11 Then
                monthIndex = 0
            Else
                monthIndex = monthIndex + 1
            End If
            If previousDate = 24 Then
                newSheet.Name = 1 & " " & monthsArray(monthIndex)
            ElseIf previousDate = 25 Then
                newSheet.Name = 2 & " " & monthsArray(monthIndex)
            ElseIf previousDate = 26 Then
                newSheet.Name = 3 & " " & monthsArray(monthIndex)
            ElseIf previousDate = 27 Then
                newSheet.Name = 4 & " " & monthsArray(monthIndex)
            ElseIf previousDate = 28 Then
                newSheet.Name = 5 & " " & monthsArray(monthIndex)
            ElseIf previousDate = 29 Then
                newSheet.Name = 6 & " " & monthsArray(monthIndex)
            ElseIf previousDate = 30 Then
                newSheet.Name = 7 & " " & monthsArray(monthIndex)
            Else
                MsgBox ("Could not assign date appropriately, please manually fix.")
            End If
        ElseIf previousDate <= 23 Then
            newSheet.Name = previousDate + 7 & " " & monthsArray(monthIndex)
        End If
    ElseIf monthIndex = 1 Then
        If previousDate > 21 Then
            If monthIndex = 11 Then
                monthIndex = 0
            Else
                monthIndex = monthIndex + 1
            End If
            If previousDate = 22 Then
                newSheet.Name = 1 & " " & monthsArray(monthIndex)
            ElseIf previousDate = 23 Then
                newSheet.Name = 2 & " " & monthsArray(monthIndex)
            ElseIf previousDate = 24 Then
                newSheet.Name = 3 & " " & monthsArray(monthIndex)
            ElseIf previousDate = 25 Then
                newSheet.Name = 4 & " " & monthsArray(monthIndex)
            ElseIf previousDate = 26 Then
                newSheet.Name = 5 & " " & monthsArray(monthIndex)
            ElseIf previousDate = 27 Then
                newSheet.Name = 6 & " " & monthsArray(monthIndex)
            ElseIf previousDate = 28 Then
                newSheet.Name = 7 & " " & monthsArray(monthIndex)
            Else
                MsgBox ("Could not assign date appropriately, please manually fix.")
            End If
        ElseIf previousDate <= 21 Then
            newSheet.Name = previousDate + 7 & " " & monthsArray(monthIndex)
        End If
    End If
    
    'Clears contents of original sheet (if this is the right range? modify if needed)
    copySheet.Range("Q8:AB25").ClearContents
    
End Sub

[georgiboy]

How about something like this:
It assumes the sheet to be copied is the active sheet and is in the current year.

Sub test()    
    Dim shName As String, tmpDate As Date, newName As String
    
    shName = ActiveSheet.Name
    tmpDate = DateValue(shName & " " & Year(Date))
    newName = Format(tmpDate + 7, "d mmmm")
    
    ActiveSheet.Copy , Sheets(Sheets.Count)
    Sheets(shName & " (2)").Name = newName
    Sheets(newName).Range("Q8:AB25").ClearContents
    
End Sub

Hope this helps

[Grade4.2]

Mattreigold, you are amazing, I'll follow both formulas tomorrow and get back to you. Thank you for taking the time and effort to help me.

[Grade4.2]

Thank you georgiboy, I am in aww of what you guys can achieve. I'll have a reply tomorrow.

[Grade4.2]

Thanks to the both of you, I can now mark this as solved...I just don't know how to do that.

[georgiboy]

Glad it worked for you,
I don't post many questions but I think it's at the top of the screen when you're in the thread, it may be called something like "thread tools" but I'm not sure.

[mattreingold]

Glad we could help! Georgiboy has that much more 'eloquent' solution I mentioned lol