VBA to automatically create A workbook with # of Sheets

[thardin]

I want to write a macro that will automatically create a Workbook with a specific number of sheets based on the amount of days in the current month(one worksheet for each day of the month).
With the worksheets named 1st, 2nd, 3rd, etc.

How would you do this?

 

[JEC]

I advice you not to use that many sheets, like 1 for 1 month. Keeping everything in one sheet is the best way. Then you can analyse from that one specific sheet

 

[Fluff]

How about

Sub thardin()
   Dim Dys As Long, Curr As Long, i As Long
   
   Dys = Day(DateSerial(Year(Date), Month(Date) + 1, 0))
   With Application
      Curr = .SheetsInNewWorkbook
      .SheetsInNewWorkbook = Dys
      .Workbooks.Add
      .SheetsInNewWorkbook = Curr
   End With
   For i = 1 To Dys
      Sheets(i).Name = Ordinals(i)
   Next i
End Sub
Function Ordinals(ByVal Indx As Long) As String
   Dim i As Long
   Const Ord = "stndrdthththththth" ' 2 char suffixes
   i = Indx Mod 100
   If ((Abs(i) >= 10) And (Abs(i) <= 19)) Or ((Abs(i) Mod 10) = 0) Then
      Ordinals = i & "th"
   Else
      Ordinals = i & Mid(Ord, ((Abs(i) Mod 10) * 2) - 1, 2)
   End If
End Function

 

[thardin]

How about

Sub thardin()
   Dim Dys As Long, Curr As Long, i As Long
  
   Dys = Day(DateSerial(Year(Date), Month(Date) + 1, 0))
   With Application
      Curr = .SheetsInNewWorkbook
      .SheetsInNewWorkbook = Dys
      .Workbooks.Add
      .SheetsInNewWorkbook = Curr
   End With
   For i = 1 To Dys
      Sheets(i).Name = Ordinals(i)
   Next i
End Sub
Function Ordinals(ByVal Indx As Long) As String
   Dim i As Long
   Const Ord = "stndrdthththththth" ' 2 char suffixes
   i = Indx Mod 100
   If ((Abs(i) >= 10) And (Abs(i) <= 19)) Or ((Abs(i) Mod 10) = 0) Then
      Ordinals = i & "th"
   Else
      Ordinals = i & Mid(Ord, ((Abs(i) Mod 10) * 2) - 1, 2)
   End If
End Function

Thats PERFECT! almost like magic, lol.

Thank you!

 

[Fluff]

Glad we could help & thanks for the feedback.

 

[thardin]

Just one question though, how do you make it so this wb is saved AS SOON as it is created. because when I try this, it is saving another workbook:

Sub Create_New_MonthFile()
Dim Dys As Long, Curr As Long, i As Long
Dim FileName As String
Dim wb As Workbook
Set wb = ActiveWorkbook

FileName = strMonthShort & "-" & strMonthMed & "-" & strYearShort & ".xlsx"
Dys = Day(DateSerial(Year(Date), Month(Date) + 1, 0))
With Application
Curr = .SheetsInNewWorkbook
.SheetsInNewWorkbook = Dys
.Workbooks.Add
wb.SaveAs WED_MONTH_FOLDER & strYearFolder & FileName, FileFormat:=51
.SheetsInNewWorkbook = Curr
End With
For i = 1 To Dys
Sheets(i).Name = Ordinals(i)
Next i
End Sub

 

[Fluff]

In future when posting code please use code tags. How to Post Your VBA Code
You have a lot of variables that have no value. What are they meant to be?

 

[thardin]

They are constants and public variables in another module

 

[Fluff]

In that case try

Sub thardin()
   Dim Dys As Long, Curr As Long, i As Long
   Dim Fname As String
   
   Dys = Day(DateSerial(Year(Date), Month(Date) + 1, 0))
   Fname = strMonthShort & "-" & strMonthMed & "-" & strYearShort & ".xlsx"
   With Application
      Curr = .SheetsInNewWorkbook
      .SheetsInNewWorkbook = Dys
      .Workbooks.Add
      .SheetsInNewWorkbook = Curr
   End With
   For i = 1 To Dys
      Sheets(i).Name = Ordinals(i)
   Next i
   ActiveWorkbook.SaveAs WED_MONTH_FOLDER & strYearFolder & Fname, 51
End Sub

PS never use VBA keywords for the names of variables or procedures.

 

[thardin]

Great!, It worked! Thanks