Date formats change (code included)
 

I currently have a worksheet that uses VBA code which creates a worksheet for
each day of the month using the MMM-d date format. It works fine this way but
it would be better if I could get it to name each sheet as 1st through 31st
NOT Jan-1 through Jan-31. A section of the code follows:


Do While i < 32 'counting 31 loops
If Month(firstday + i) = mon Then 'checking to see if 31st day is
still within the month
dayofweek = Weekday(firstday + i) 'retrieving day of the week from
date
currentday = firstday + i 'calculating loop date
currentday = Format(currentday, "mmm-d") 'formatting loop day for tab
name
Select Case dayofweek 'choosing correct kind of template
Case 1, 7 'weekend template
Sheets("Summer Weekend").Select 'select weekend template
Sheets("Summer Weekend").Copy Befo=Sheets(1) 'pasting copy
as first
Sheets("Summer Weekend (2)").Select
Sheets("Summer Weekend (2)").Name = currentday 'changing tab
name to loop date
Case 2, 3, 4, 5, 6 'weekday template
Sheets("Summer Weekday").Select
Sheets("Summer Weekday").Copy Befo=Sheets(1)
Sheets("Summer Weekday (2)").Select
Sheets("Sum

Date formats change (code included)
 

Hi Paolo

I created a file for making Monthly workbooks with days of month as
worksheets.
It is available for download at
http://excelusergroup.org/media/p/236.aspx
See if the code there helps you in any way.

--
Regards
Roger Govier

"Paolo" wrote in message
...
I currently have a worksheet that uses VBA code which creates a worksheet
for
each day of the month using the MMM-d date format. It works fine this way
but
it would be better if I could get it to name each sheet as 1st through
31st
NOT Jan-1 through Jan-31. A section of the code follows:


Do While i < 32 'counting 31 loops
If Month(firstday + i) = mon Then 'checking to see if 31st day is
still within the month
dayofweek = Weekday(firstday + i) 'retrieving day of the week from
date
currentday = firstday + i 'calculating loop date
currentday = Format(currentday, "mmm-d") 'formatting loop day for
tab
name
Select Case dayofweek 'choosing correct kind of
template
Case 1, 7 'weekend template
Sheets("Summer Weekend").Select 'select weekend template
Sheets("Summer Weekend").Copy Befo=Sheets(1) 'pasting copy
as first
Sheets("Summer Weekend (2)").Select
Sheets("Summer Weekend (2)").Name = currentday 'changing tab
name to loop date
Case 2, 3, 4, 5, 6 'weekday template
Sheets("Summer Weekday").Select
Sheets("Summer Weekday").Copy Befo=Sheets(1)
Sheets("Summer Weekday (2)").Select
Sheets("Sum

Date formats change (code included)
 

Roger:
Thanks for your input. I think I will use some of the code for other things
but your dates are formatted the same as mine "MMM-D" and I would like the
sheets to be named 1st, 2nd, 3rd... according to the month and year. I dont
know if that is possible but that is what I am hoping for.

Thanks,

Paolo


"Roger Govier" wrote:

Hi Paolo

I created a file for making Monthly workbooks with days of month as
worksheets.
It is available for download at
http://excelusergroup.org/media/p/236.aspx
See if the code there helps you in any way.

--
Regards
Roger Govier

"Paolo" wrote in message
...
I currently have a worksheet that uses VBA code which creates a worksheet
for
each day of the month using the MMM-d date format. It works fine this way
but
it would be better if I could get it to name each sheet as 1st through
31st
NOT Jan-1 through Jan-31. A section of the code follows:


Do While i < 32 'counting 31 loops
If Month(firstday + i) = mon Then 'checking to see if 31st day is
still within the month
dayofweek = Weekday(firstday + i) 'retrieving day of the week from
date
currentday = firstday + i 'calculating loop date
currentday = Format(currentday, "mmm-d") 'formatting loop day for
tab
name
Select Case dayofweek 'choosing correct kind of
template
Case 1, 7 'weekend template
Sheets("Summer Weekend").Select 'select weekend template
Sheets("Summer Weekend").Copy Befo=Sheets(1) 'pasting copy
as first
Sheets("Summer Weekend (2)").Select
Sheets("Summer Weekend (2)").Name = currentday 'changing tab
name to loop date
Case 2, 3, 4, 5, 6 'weekday template
Sheets("Summer Weekday").Select
Sheets("Summer Weekday").Copy Befo=Sheets(1)
Sheets("Summer Weekday (2)").Select
Sheets("Sum

Date formats change (code included)
 

Roger, I ran your file and it immediately errored out on the JAN workbook.
After you Add the first sheet, you then delete the 3 original sheets created
with the workbook. Since my workbook options are set to create only 1 sheet
with each new workbook, your code could not do the delete and ran to your
error trap. Perhaps you should code your trap to delete all but the last
sheet, which you just added, something like For each ws in worksheets, If
ws.name < "Jan", Then ws.Delete. That should cover any number of worksheet
option the user would set.

Mike F
"Roger Govier" <roger@technology4unospamdotcodotuk wrote in message
...
Hi Paolo

I created a file for making Monthly workbooks with days of month as
worksheets.
It is available for download at
http://excelusergroup.org/media/p/236.aspx
See if the code there helps you in any way.

--
Regards
Roger Govier

"Paolo" wrote in message
...
I currently have a worksheet that uses VBA code which creates a worksheet
for
each day of the month using the MMM-d date format. It works fine this way
but
it would be better if I could get it to name each sheet as 1st through
31st
NOT Jan-1 through Jan-31. A section of the code follows:


Do While i < 32 'counting 31 loops
If Month(firstday + i) = mon Then 'checking to see if 31st day is
still within the month
dayofweek = Weekday(firstday + i) 'retrieving day of the week from
date
currentday = firstday + i 'calculating loop date
currentday = Format(currentday, "mmm-d") 'formatting loop day for
tab
name
Select Case dayofweek 'choosing correct kind of
template
Case 1, 7 'weekend template
Sheets("Summer Weekend").Select 'select weekend template
Sheets("Summer Weekend").Copy Befo=Sheets(1) 'pasting
copy
as first
Sheets("Summer Weekend (2)").Select
Sheets("Summer Weekend (2)").Name = currentday 'changing
tab
name to loop date
Case 2, 3, 4, 5, 6 'weekday template
Sheets("Summer Weekday").Select
Sheets("Summer Weekday").Copy Befo=Sheets(1)
Sheets("Summer Weekday (2)").Select
Sheets("Sum

Date formats change (code included)
 

VBA and Excel do not have a built in facility to support the Ordinal Number
format, however, I found this on the net which you might be able to adapt and
use.

http://www.vbaexpress.com/kb/getarticle.php?kb_id=1029

"Paolo" wrote:

Roger:
Thanks for your input. I think I will use some of the code for other things
but your dates are formatted the same as mine "MMM-D" and I would like the
sheets to be named 1st, 2nd, 3rd... according to the month and year. I dont
know if that is possible but that is what I am hoping for.

Thanks,

Paolo


"Roger Govier" wrote:

Hi Paolo

I created a file for making Monthly workbooks with days of month as
worksheets.
It is available for download at
http://excelusergroup.org/media/p/236.aspx
See if the code there helps you in any way.

--
Regards
Roger Govier

"Paolo" wrote in message
...
I currently have a worksheet that uses VBA code which creates a worksheet
for
each day of the month using the MMM-d date format. It works fine this way
but
it would be better if I could get it to name each sheet as 1st through
31st
NOT Jan-1 through Jan-31. A section of the code follows:


Do While i < 32 'counting 31 loops
If Month(firstday + i) = mon Then 'checking to see if 31st day is
still within the month
dayofweek = Weekday(firstday + i) 'retrieving day of the week from
date
currentday = firstday + i 'calculating loop date
currentday = Format(currentday, "mmm-d") 'formatting loop day for
tab
name
Select Case dayofweek 'choosing correct kind of
template
Case 1, 7 'weekend template
Sheets("Summer Weekend").Select 'select weekend template
Sheets("Summer Weekend").Copy Befo=Sheets(1) 'pasting copy
as first
Sheets("Summer Weekend (2)").Select
Sheets("Summer Weekend (2)").Name = currentday 'changing tab
name to loop date
Case 2, 3, 4, 5, 6 'weekday template
Sheets("Summer Weekday").Select
Sheets("Summer Weekday").Copy Befo=Sheets(1)
Sheets("Summer Weekday (2)").Select
Sheets("Sum

Date formats change (code included)
 

Paolo, I think you should set up a variable just for the sheet names like
Dim TabName As String, and for the Day of Month, Dim MyDay As Integer. You
could then set up a Select Case DayOfMonth to create your Tab Name.
Select Case MyDay
Case 1, 21, 31
TabName = MyDay & "st"
Case 2, 22
TabName = MyDay & "nd"
Case 3, 23
TabName = MyDay & "rd"
Case Else
TabName = MyDay & "th"
End Select

Mike F
"Paolo" wrote in message
...
Roger:
Thanks for your input. I think I will use some of the code for other
things
but your dates are formatted the same as mine "MMM-D" and I would like the
sheets to be named 1st, 2nd, 3rd... according to the month and year. I
dont
know if that is possible but that is what I am hoping for.

Thanks,

Paolo


"Roger Govier" wrote:

Hi Paolo

I created a file for making Monthly workbooks with days of month as
worksheets.
It is available for download at
http://excelusergroup.org/media/p/236.aspx
See if the code there helps you in any way.

--
Regards
Roger Govier

"Paolo" wrote in message
...
I currently have a worksheet that uses VBA code which creates a
worksheet
for
each day of the month using the MMM-d date format. It works fine this
way
but
it would be better if I could get it to name each sheet as 1st through
31st
NOT Jan-1 through Jan-31. A section of the code follows:


Do While i < 32 'counting 31 loops
If Month(firstday + i) = mon Then 'checking to see if 31st day
is
still within the month
dayofweek = Weekday(firstday + i) 'retrieving day of the week
from
date
currentday = firstday + i 'calculating loop date
currentday = Format(currentday, "mmm-d") 'formatting loop day for
tab
name
Select Case dayofweek 'choosing correct kind of
template
Case 1, 7 'weekend template
Sheets("Summer Weekend").Select 'select weekend template
Sheets("Summer Weekend").Copy Befo=Sheets(1) 'pasting
copy
as first
Sheets("Summer Weekend (2)").Select
Sheets("Summer Weekend (2)").Name = currentday 'changing
tab
name to loop date
Case 2, 3, 4, 5, 6 'weekday template
Sheets("Summer Weekday").Select
Sheets("Summer Weekday").Copy Befo=Sheets(1)
Sheets("Summer Weekday (2)").Select
Sheets("Sum

Date formats change (code included)
 

Hi Mike

Very many thanks for pointing that out.
Stupid of me to think that everyone uses the Excel default workbook
creation.
I will put in the error trap - as you suggest - and will post a revised copy
of the workbook to the site.

--
Regards
Roger Govier

"Mike Fogleman" wrote in message
...
Roger, I ran your file and it immediately errored out on the JAN workbook.
After you Add the first sheet, you then delete the 3 original sheets
created with the workbook. Since my workbook options are set to create
only 1 sheet with each new workbook, your code could not do the delete and
ran to your error trap. Perhaps you should code your trap to delete all
but the last sheet, which you just added, something like For each ws in
worksheets, If ws.name < "Jan", Then ws.Delete. That should cover any
number of worksheet option the user would set.

Mike F
"Roger Govier" <roger@technology4unospamdotcodotuk wrote in message
...
Hi Paolo

I created a file for making Monthly workbooks with days of month as
worksheets.
It is available for download at
http://excelusergroup.org/media/p/236.aspx
See if the code there helps you in any way.

--
Regards
Roger Govier

"Paolo" wrote in message
...
I currently have a worksheet that uses VBA code which creates a
worksheet for
each day of the month using the MMM-d date format. It works fine this
way but
it would be better if I could get it to name each sheet as 1st through
31st
NOT Jan-1 through Jan-31. A section of the code follows:


Do While i < 32 'counting 31 loops
If Month(firstday + i) = mon Then 'checking to see if 31st day is
still within the month
dayofweek = Weekday(firstday + i) 'retrieving day of the week
from
date
currentday = firstday + i 'calculating loop date
currentday = Format(currentday, "mmm-d") 'formatting loop day for
tab
name
Select Case dayofweek 'choosing correct kind of
template
Case 1, 7 'weekend template
Sheets("Summer Weekend").Select 'select weekend template
Sheets("Summer Weekend").Copy Befo=Sheets(1) 'pasting
copy
as first
Sheets("Summer Weekend (2)").Select
Sheets("Summer Weekend (2)").Name = currentday 'changing
tab
name to loop date
Case 2, 3, 4, 5, 6 'weekday template
Sheets("Summer Weekday").Select
Sheets("Summer Weekday").Copy Befo=Sheets(1)
Sheets("Summer Weekday (2)").Select
Sheets("Sum

Date formats change (code included)
 

Added the code and your suggestion for using Ordinals in the date names
Code as posted below

Sub CreateBooksandSheets()
Dim month As String, year As String, tabname As String
Dim i As Long, m As Long, myday As Long
Dim ordinals As Boolean
Dim ws As Worksheet
On Error GoTo CreateBooksandSheets_Error
Application.DisplayAlerts = False
askyear:
year = InputBox("Enter the Year number required" _
& vbCrLf & "in the format of 2008" _
& vbCrLf & "" _
& vbCrLf & "This will determine the correct" _
& vbCrLf & "number of days for February." _
, "Select which Year", "2008")
If Val(year) <= 1 Then Exit Sub
If Val(year) < 1999 And Val(year) 3000 Then
GoTo askyear
End If
For m = 1 To 12 ' i.e. for each of the 12 months of the year
month = MonthName(m, True) 'select monthname in short Form
' test if file for Month already exists, If so ask user whether they
want to overwrite the file
' uses the IsFile function below this module
If IsFile(month & ".xls") Then
Select Case MsgBox("The file " & month & ".xls" _
& vbCrLf & "already exists." _
& vbCrLf & "Do you want to Overwrite?" _
, vbYesNo Or vbCritical Or vbDefaultButton2,
"File Already Exists")
Case vbNo
GoTo nextmonth
Case vbYes
End Select
End If
' ask if the user want to use ordinals for the day numbers 1st, 2nd,
3rd etc.
' added after suggestion by Mike Fogleman
Select Case MsgBox("Do you want to use Ordinals for the number
format" _
& vbCrLf & "e.g Jan 1st, Jan 2nd etc." _
& vbCrLf & "Answer YES if required, or NO to
leave as Jan 01, Jan 02" _
, vbYesNo Or vbQuestion Or vbDefaultButton1,
Application.Name)
Case vbYes
ordinals = True
Case vbNo
ordinals = False
End Select
Workbooks.Add 'create new Workbook and save
as Month name
On Error Resume Next ' user has said Ok to overwrite to ignore
warning
ActiveWorkbook.SaveAs Filename:=month & ".xls", _
FileFormat:=xlNormal, Password:="",
WriteResPassword:="", _
ReadOnlyRecommended:=False,
CreateBackup:=False
On Error GoTo CreateBooksandSheets_Error ' set error point back
'add new sheet after existing sheets in workbook and name it same as
month
Worksheets.Add(After:=Sheets(Sheets.Count)).Name = month
'delete any other sheets in the newly opened workbook
' amended from deleting the array of Sheet1, Sheet2, Sheet3 after
it was pointed
' out by Mike Fogleman, there is no guarantee that the user allows
new
' workbooks to be created with 3 sheets.
For Each ws In ActiveWorkbook.Worksheets
If ws.Name < month Then
ws.Delete
End If
Next
'Create date for first of month in cell A1
ActiveSheet.Cells(1, 1) = "01" & "/" & month & "/" & year
'create formula for last day of month in cell B1
ActiveSheet.Cells(1, 2).FormulaR1C1 =
"=DATE(YEAR(RC[-1]),MONTH(RC[-1])+1,0)"
'create formula to give day number of last day of month in C1
ActiveSheet.Cells(1, 3).FormulaR1C1 = "=DAY(RC[-1])"
' loop for as many days as there are in month (from day 2) through
column A, adding 1 day
' to previous days value
For i = 2 To Cells(1, 3).Value
Cells(i, 1) = Cells(i, 1).Offset(-1, 0).Value + 1
Next i
' loop for as many days in the month, adding a new worksheet, and
giving it the name
' of each cell in column A for the first sheet created (Month),
setting the format to be
' mmm dd or Jan 01
For i = 1 To Cells(1, 3).Value
myday = Day(Sheets(month).Cells(i, 1).Value)
If ordinals < True Then
Worksheets.Add(After:=Sheets(Sheets.Count)). _
Name = Format(Sheets(month).Cells(i, 1), "mmm dd")
Else
Select Case myday
Case 1, 21, 31
tabname = myday & "st"
Case 2, 22
tabname = myday & "nd"
Case 3, 23
tabname = myday & "rd"
Case Else
tabname = myday & "th"
End Select
tabname = month & " " & tabname
Worksheets.Add(After:=Sheets(Sheets.Count)). _
Name = tabname
End If
Next i
' now delete the first sheet created with just the month name
Sheets(month).Delete
' step up month number to next month and repeat procedure
' this is the point we jump to if file exists and user says NO to
overwrite.
ActiveWorkbook.Close Savechanges:=True
nextmonth:
Next m
On Error GoTo 0
Application.DisplayAlerts = True
Exit Sub
CreateBooksandSheets_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure
CreateBooksandSheets of Module Module1"
Application.DisplayAlerts = True
End Sub


Function IsFile(s As String) As Boolean
'tests whether a file exists. Returns True if it does or False
Dim fs
Set fs = CreateObject("Scripting.FileSystemObject")
IsFile = fs.FileExists(s)
End Function




--
Regards
Roger Govier

"Roger Govier" <roger@technology4unospamdotcodotuk wrote in message
...
Hi Mike

Very many thanks for pointing that out.
Stupid of me to think that everyone uses the Excel default workbook
creation.
I will put in the error trap - as you suggest - and will post a revised
copy of the workbook to the site.

--
Regards
Roger Govier

"Mike Fogleman" wrote in message
...
Roger, I ran your file and it immediately errored out on the JAN
workbook. After you Add the first sheet, you then delete the 3 original
sheets created with the workbook. Since my workbook options are set to
create only 1 sheet with each new workbook, your code could not do the
delete and ran to your error trap. Perhaps you should code your trap to
delete all but the last sheet, which you just added, something like For
each ws in worksheets, If ws.name < "Jan", Then ws.Delete. That should
cover any number of worksheet option the user would set.

Mike F

Date formats change (code included)
 

Sorry Paolo

I hadn't read your message properly.
I have amended the code to deal with the problem Mike raised about deleting
sheets, and incorporating his suggestion for creating ordinal numbers.
Code posted as a reply to his message.

--
Regards
Roger Govier

"Paolo" wrote in message
...
Roger:
Thanks for your input. I think I will use some of the code for other
things
but your dates are formatted the same as mine "MMM-D" and I would like the
sheets to be named 1st, 2nd, 3rd... according to the month and year. I
dont
know if that is possible but that is what I am hoping for.

Thanks,

Paolo


"Roger Govier" wrote:

Hi Paolo

I created a file for making Monthly workbooks with days of month as
worksheets.
It is available for download at
http://excelusergroup.org/media/p/236.aspx
See if the code there helps you in any way.

--
Regards
Roger Govier

"Paolo" wrote in message
...
I currently have a worksheet that uses VBA code which creates a
worksheet
for
each day of the month using the MMM-d date format. It works fine this
way
but
it would be better if I could get it to name each sheet as 1st through
31st
NOT Jan-1 through Jan-31. A section of the code follows:


Do While i < 32 'counting 31 loops
If Month(firstday + i) = mon Then 'checking to see if 31st day
is
still within the month
dayofweek = Weekday(firstday + i) 'retrieving day of the week
from
date
currentday = firstday + i 'calculating loop date
currentday = Format(currentday, "mmm-d") 'formatting loop day for
tab
name
Select Case dayofweek 'choosing correct kind of
template
Case 1, 7 'weekend template
Sheets("Summer Weekend").Select 'select weekend template
Sheets("Summer Weekend").Copy Befo=Sheets(1) 'pasting
copy
as first
Sheets("Summer Weekend (2)").Select
Sheets("Summer Weekend (2)").Name = currentday 'changing
tab
name to loop date
Case 2, 3, 4, 5, 6 'weekday template
Sheets("Summer Weekday").Select
Sheets("Summer Weekday").Copy Befo=Sheets(1)
Sheets("Summer Weekday (2)").Select
Sheets("Sum

Date formats change (code included)
 

Here is a one-liner function for adding the ordinal suffix that I developed
many years ago in my compiled VB days...

Function Ordinal(Number As Long) As String
Ordinal = Number & Mid$("thstndrdthththththth", 1 - 2 * _
((Number) Mod 10) * (Abs((Number) Mod 100 - 12) 1), 2)
End Function

--
Rick (MVP - Excel)


"JLGWhiz" wrote in message
...
VBA and Excel do not have a built in facility to support the Ordinal
Number
format, however, I found this on the net which you might be able to adapt
and
use.

http://www.vbaexpress.com/kb/getarticle.php?kb_id=1029

"Paolo" wrote:

Roger:
Thanks for your input. I think I will use some of the code for other
things
but your dates are formatted the same as mine "MMM-D" and I would like
the
sheets to be named 1st, 2nd, 3rd... according to the month and year. I
dont
know if that is possible but that is what I am hoping for.

Thanks,

Paolo


"Roger Govier" wrote:

Hi Paolo

I created a file for making Monthly workbooks with days of month as
worksheets.
It is available for download at
http://excelusergroup.org/media/p/236.aspx
See if the code there helps you in any way.

--
Regards
Roger Govier

"Paolo" wrote in message
...
I currently have a worksheet that uses VBA code which creates a
worksheet
for
each day of the month using the MMM-d date format. It works fine this
way
but
it would be better if I could get it to name each sheet as 1st
through
31st
NOT Jan-1 through Jan-31. A section of the code follows:


Do While i < 32 'counting 31 loops
If Month(firstday + i) = mon Then 'checking to see if 31st day
is
still within the month
dayofweek = Weekday(firstday + i) 'retrieving day of the week
from
date
currentday = firstday + i 'calculating loop date
currentday = Format(currentday, "mmm-d") 'formatting loop day
for
tab
name
Select Case dayofweek 'choosing correct kind of
template
Case 1, 7 'weekend template
Sheets("Summer Weekend").Select 'select weekend
template
Sheets("Summer Weekend").Copy Befo=Sheets(1) 'pasting
copy
as first
Sheets("Summer Weekend (2)").Select
Sheets("Summer Weekend (2)").Name = currentday
'changing tab
name to loop date
Case 2, 3, 4, 5, 6 'weekday template
Sheets("Summer Weekday").Select
Sheets("Summer Weekday").Copy Befo=Sheets(1)
Sheets("Summer Weekday (2)").Select
Sheets("Sum