Rename Multiple Tabs

[Mulderman]

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

 

[PCL]

Perhaps
It's up to you to prepare the right number of sheets.

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]

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]

Yes I forgot completely the Sunday skip, here another try.

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.

 

[Legacy 68668]

try

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]

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]

Using previous lesson (Thank you Seiya's code) here my new 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