Printable View
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.
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:
Please come back if you need anything tweaked/adjusted!Code: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
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. :yes
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,
Code: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
How about something like this:
It assumes the sheet to be copied is the active sheet and is in the current year.
Hope this helpsCode: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
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.
Thank you georgiboy, I am in aww of what you guys can achieve. I'll have a reply tomorrow.
Thanks to the both of you, I can now mark this as solved...I just don't know how to do that.
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.
Glad we could help! Georgiboy has that much more 'eloquent' solution I mentioned lol