Rename Multiple Tabs

Mulderman

Board Regular
Joined
Sep 2, 2007
Messages
69
Hi there

Could you help with an onerous task that I must complete every Quarter.

I have a spreadsheet with multiple tabs.

The first 3 Tabs are Calculation sheets and do not need to be re-named.

All the preceeding sheets each need to be renamed to the days of the month (British Format), skiping Sundays.

i.e Tab 4 should be renamed 010409, Tab 5 should be renamed 020409, Tab 6 should be renamed 030409, Tab 7 should be renamed 040409, Tab 8 should be renamed 060409 and Tab 9 should be renamed 070409 etc etc ...

Extra - Also if possible on each sheet could the Tab date be placed into Cell A4 (eg. 010409) and also the Day number (eg. 01) (Starting from 01 on 010409, 02 on 020409, 03 on 030409, 04 on 040409, 05 on 060409, 06 on 070409 etc etc ...) into Cell A6.

I would appreciate any help you may offer.

Many Thanks

Mulderman
 

Some videos you may like

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest

PCL

Well-known Member
Joined
Jul 15, 2008
Messages
1,348
Perhaps
It's up to you to prepare the right number of sheets.
Code:
Option Explicit
Sub Sheet_Rename()
Dim I As Integer
Dim MonthNb As Variant
Dim MyString As String
Dim MyDay As String
    On Error GoTo ENDSUB
    MonthNb = Application.InputBox("Give a month Number")
    MonthNb = MonthNb * 1
    If ((MonthNb >= 1) And (MonthNb <= 12)) Then
        If (MonthNb < 10) Then
            MyString = "0" & MonthNb & "09"
            Else
            MyString = MonthNb & "09"
        End If
        
        For I = 4 To Sheets.Count
            Sheets(I).Select
            If (I < 14) Then
                MyDay = "0" & I - 3
            Else
                MyDay = I - 3
            End If
            Sheets(I).Name = MyDay & MyString
            Sheets(I).Range("A4") = MyDay & MyString
            Sheets(I).Range("A6") = MyDay
        Next I
    End If
ENDSUB:
End Sub
 

Mulderman

Board Regular
Joined
Sep 2, 2007
Messages
69
Thanks for this PCL, its a great help !

Just a point to tinker with.

At present the code is not skipping Sundays. My workbook doesnt have any tabs for Sundays so I need the rename to skip any Sunday dates.

Any idea's ??

Cheers

Mulderman
 

PCL

Well-known Member
Joined
Jul 15, 2008
Messages
1,348
Yes I forgot completely the Sunday skip, here another try.
Code:
Option Explicit
Sub Sheet_Rename()
Dim I As Integer, J As Integer
Dim MonthNb As Variant
Dim MyString As String
Dim MyDay As String
Dim MyYEAR As String
Dim WeekDayTest As Integer
Dim WeekDayTest2 As Integer
Dim Date_Nb As Date
Dim Date_Nb2 As Date
    MyYEAR = "2009"
    On Error GoTo ENDSUB
    MonthNb = Application.InputBox("Give a MONTH NUMBER")
    MonthNb = MonthNb * 1                       '  TURN  TO  NUMBER IN CASE IT'S NOT  or MAKE AN ERROR
    
    If ((MonthNb >= 1) And (MonthNb <= 12)) Then
        If (MonthNb < 10) Then                  '  PREPARE MONTH WITH 2 CHARACTERS
            MyString = "0" & MonthNb & Right(MyYEAR, 2)
            Else
            MyString = MonthNb & Right(MyYEAR, 2)
        End If
        J = 1
        For I = 4 To Sheets.Count
            Sheets(I).Select
'-------    DETERMINE  WEEKDAY
            Date_Nb = MonthNb & "/" & J & "/" & MyYEAR         '  DATE  FOR  EXCEL
            Date_Nb2 = J & "/" & MonthNb & "/" & MyYEAR        '  DATE  FOR  EXCEL
            WeekDayTest = WorksheetFunction.Weekday(Date_Nb * 1, 2)
            WeekDayTest2 = WorksheetFunction.Weekday(Date_Nb2 * 1, 2)
            
            If (WeekDayTest = 7) Then J = J + 1         '  IT  WAS A  SUNDAY
            If (J < 14) Then
                MyDay = "0" & J                  '  PREPARE DAY WITH 2 CHARACTERS
            Else
                MyDay = J
            End If
            
            Sheets(I).Name = MyDay & MyString
            Sheets(I).Range("A4") = MyDay & MyString
            Sheets(I).Range("A6") = MyDay
            J = J + 1
        Next I
    End If
ENDSUB:
End Sub
Please test and confirm.
 
L

Legacy 68668

Guest

ADVERTISEMENT

try
Code:
Sub test()
Dim i As Long, myDate As Date
myDate = DateSerial(Year(Date), Month(Date), 0)
For i = 3 To Sheets.Count
    Do
        myDate = DateAdd("d", 1, myDate)
    Loop Until WeekDay(myDate) <> 1
    With Sheets(i)
        .Name = Format(myDate, "ddmmyy")
        With .Range("a6")
            .NumberFormat = "dd"
            .Value = myDate
        End With
    End Wtih
Next
End Sub
 

Mulderman

Board Regular
Joined
Sep 2, 2007
Messages
69
Thanks Guys, both options allowed me to choose the best bits of code and alter it to fit my personal project.

You both saved me considerable manual work, so with that in mind, may I thank you both publically and privately for a job well done !

Cheers

Mulderman
 

PCL

Well-known Member
Joined
Jul 15, 2008
Messages
1,348
Using previous lesson (Thank you Seiya's code) here my new code.

Code:
Sub Sheet_Rename2()
Dim I As Integer, J As Integer
Dim MyMonth As Variant
Dim MyYEAR As String
Dim WeekDayTest As Integer
Dim myDate As Date
    MyYEAR = "2009"
    On Error GoTo ENDSUB
    MyMonth = Application.InputBox("Give a MONTH NUMBER")
    MyMonth = MyMonth * 1                         '  TURN  TO  NUMBER IN CASE IT'S NOT  or MAKE AN ERROR
    
    If ((MyMonth >= 1) And (MyMonth <= 12)) Then
        J = 1
        For I = 4 To Sheets.Count
            With Sheets(I)
                myDate = DateSerial(MyYEAR, MyMonth, J)
                WeekDayTest = Weekday(myDate, 2)
                If (WeekDayTest = 7) Then J = J + 1         '  IT  WAS A  SUNDAY
                .Name = Format(myDate, "ddmmyy")
                .Range("A4").NumberFormat = "ddmmyy"
                .Range("A4") = myDate
                .Range("A6").NumberFormat = "dd"
                .Range("A6") = J
                J = J + 1
            End With
        Next I
    End If
ENDSUB:
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,122,521
Messages
5,596,653
Members
414,083
Latest member
Mrsash

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
Top