Macro to create daily worksheets

[Phil]

Hi all,

I need code to create one worksheet for each working day of a given
month. The user would enter the first day of the month in a cell, and
the macro would then create a series of new sheets, one for each
working day of that month, and name them accordingly.

For example the september 2010 workbook would have the date 01/09/2010
entered in a cell and the macro should calculate the number of working
days in that month and create a worksheet for each one, named 01-
Sep-2010 and so on.

I've tried to do this myself and keep getting stuck ... now I'm
running out of both time and the will to live! I hope it's a challenge
that someone out there may find interesting.

Many thanks,

Phil

 

[Gord Dibben]

Open a new workbook.

Delete all but one sheet.

Add a first day of month like September 1, 2010 in A1

Run this macro.

Sub AllDaysAsWorksheets()
Dim d As Date

If Sheets.Count > 1 Then
MsgBox "More than 1 sheet exists. Quitting now."
Else
Application.ScreenUpdating = False
Sheets(1).Activate
d = Range("A1").Value
Sheets(1).Name = Format(d, "dd-mmm-yyyy")
d = d + 1
Do
Sheets(1).Copy After:=Sheets(Sheets.Count)
With Sheets(Sheets.Count)
.Activate
.Name = Format(d, "dd-mmm-yyyy")
End With
Range("A1").Value = d
d = d + 1
Loop Until Day(d) = 1
Application.ScreenUpdating = True
End If
End Sub


Gord Dibben MS Excel MVP

 

[Dave Peterson]

I think the real problem you're going to have is defining what working days
means. In the USA, Holidays are different between states and even cities.

But this may get you closer:

Option Explicit
Sub testme()
Dim myDate As Variant
Dim iDate As Long
Dim StartDate As Date
Dim FinishDate As Date
Dim wks As Worksheet

myDate = ActiveSheet.Range("A1").Value

If IsDate(myDate) = False Then
MsgBox "Please enter a date"
Exit Sub
End If

StartDate = DateSerial(Year(myDate), Month(myDate), 1)
FinishDate = DateSerial(Year(myDate), Month(myDate) + 1, 0)

For iDate = StartDate To FinishDate
Select Case Weekday(iDate)
Case Is = vbSaturday, vbSunday
'do nothing
Case Else
With ActiveWorkbook
Set wks = .Worksheets.Add(after:=.Worksheets(.Sheets.Count))
On Error Resume Next
wks.Name = Format(iDate, "yyyy-mm-dd")
If Err.Number <> 0 Then
Err.Clear
MsgBox "Could not rename: " & wks.Name
End If
On Error GoTo 0
End With
End Select
Next iDate

End Sub

 

[Gord Dibben]

Thanks for the correction Dave.

Missed "working days"


Gord

 

[Dave Peterson]

Gord, it wasn't a correction -- just a coincidence that I posted after yours (by
a minute!).

Anyway, I'm still not sure how the OP wants to handle workdays...

 

[Phil]

Hi Guys,

A huge thanks to both of you for your replies. Although both work
fine, I'm going with Dave's as it ignores weekends (Mondays to Fridays
being what I regard as "working days."

A good point about public holidays though - I tried solving this by
having some kind of reference list for the dates of these inparticular
years. However as we only have 8 per year in the UK (well, we don't
think it's very many!) then I'll simplify the problem by simply
deleting the public holiday sheets where they occur.

Once again thanks to both of you for your very elegant solutions!

Best Wishes

Phil

 

[Gord Dibben]

Thanks for clearing that up Phil

Good luck with the project.


Gord