Solved: Month building code issue

[Nurofen]

Hi,

the code below creates a day for every day in the month, where Sunday appears it changes it to Week Totals and the last tab A Month End Total.

What I have found is that it seems to miss a day off the end of the Month
October till the 30th, 31st does not appear I've tried to work it out but no joy.

EDIT:: The problem only occurs when its a 31 day month and when hits Feb with 29 days


Sub MyMacro10()
Dim Dte As Date, Dy As Date
Dim i As Long, j As Long, Dys As Long
Dim CountWeek As Boolean
Dim Shts As Long

Application.ScreenUpdating = False


'Get 1st of month
Dte = DateValue("1/" & Month(Date) & "/" & Year(Date))
'Count days in month
Dys = DateAdd("m", 1, Dte) - Dte
'Add requisite sheets
Shts = Sheets.Count
Sheets.Add after:=Sheets(Shts), Count:=(Dys + 1)
' Loop through sheets
For i = Shts + 1 To Sheets.Count - 1
'Get date
Dy = DateValue(i - Shts & "/" & Month(Date) & "/" & Year(Date))
Select Case Weekday(Dy)
'If weekday
Case 2, 3, 4, 5, 6, 7
If ((Dy - Dte - Dys) = -1) Then
j = j + 1
Sheets(i).Name = "WEEK " & j
Else
Sheets(i).Name = Format(Dy, "ddd dd-mm-yy")
CountWeek = True
End If
Case Else
'If Sunday
j = j + 1
If CountWeek = True Then
Sheets(i).Name = "WEEK " & j
End If
End Select
Next
'Add total
Sheets(Sheets.Count).Name = UCase(Format(Dy, "MMM")) & " MONTH END TOTAL"

Application.ScreenUpdating = True
End Sub

Thank you for your time

Nurofen

[XLGibbs]

To get the proper days in a month (at least by number of days), or specifically in this case to get the last numerical day


Dte = DateValue("1/" & Month(Date) & "/" & Year(Date))

EndofMonth = dateadd("d",-1,dateadd("m",1,dte))


What you want to do instead of subtracting Dte from your calculation is to subtract 1 day from the 1st of next month. Then use that day value to represent your "count"

[Bob Phillips]

Tad simpler (IMO)



Debug.Print day(dateserial(year(date),month(date),0))

[XLGibbs]

True but he gets his daate based on the 1st of the month and wants the end. He would still need to go forward a month using dateadd, then use your syntax.

[Bob Phillips]

In your example, you used Date. In mine I used Date. What is the difference?

[XLGibbs]

In the OP's original code he did this:




'Get 1st of month
Dte = DateValue("1/" & Month(Date) & "/" & Year(Date))
'Count days in month
Dys = DateAdd("m", 1, Dte) - Dte
'Add requisite sheets

where his days calculations was attempting to subtract the days.

He goes forward 1 month then subtracts the 1st date. In theory, it should work, but doesn't.

So I proposed a variation which adds a month, but subtracts a day.

All I meant was that he could use the dateserial, which is easier...but perhaps like this:

day(dateserial(year(dateadd("m",1,dte), month(dateadd("m",1,dte),0)

which would produce 31 where variable "dte" = 10/1/2007 (US Date, October 1, 2007, not UK date January 10,2007)


day(dateserial(year(dte), month(dte),0)

would produce 30 where variable dte = 10/1/2007 because it would be the last day of september. unless I am mistaken.

the dateserial option is easier than what I originally posted, but I wouldn't want him to get the wrong number again is all.

[Nurofen]

Hi XLGibbs,xld

Thank you both for your time.

When I add either of your code changes I only get one tab appear Dec Month End Total.

Have I put the code in the right place?

Sub MyMacro10()
Dim Dte As Date, Dy As Date
Dim i As Long, j As Long, Dys As Long
Dim CountWeek As Boolean
Dim Shts As Long

Application.ScreenUpdating = False


'Get 1st of month
Dte = DateValue("1/" & Month(Date) & "/" & Year(Date))
'Count days in month

''Dys = DateAdd("m", 1, Dte) - Dte


EndofMonth = DateAdd("d", -1, DateAdd("m", 1, Dte))

'Add requisite sheets
Shts = Sheets.Count
Sheets.Add after:=Sheets(Shts), Count:=(Dys + 1)
' Loop through sheets
For i = Shts + 1 To Sheets.Count - 1
'Get date
Dy = DateValue(i - Shts & "/" & Month(Date) & "/" & Year(Date))
Select Case Weekday(Dy)
'If weekday
Case 2, 3, 4, 5, 6, 7
If ((Dy - Dte - Dys) = -1) Then
j = j + 1
Sheets(i).Name = "WEEK " & j
Else
Sheets(i).Name = Format(Dy, "ddd dd-mm-yy")
CountWeek = True
End If
Case Else
'If Sunday
j = j + 1
If CountWeek = True Then
Sheets(i).Name = "WEEK " & j
End If
End Select
Next
'Add total
Sheets(Sheets.Count).Name = UCase(Format(Dy, "MMM")) & " MONTH END TOTAL"

Application.ScreenUpdating = True
End Sub

Sub MyMacro10()
Dim Dte As Date, Dy As Date
Dim i As Long, j As Long, Dys As Long
Dim CountWeek As Boolean
Dim Shts As Long

Application.ScreenUpdating = False


'Get 1st of month
Dte = DateValue("1/" & Month(Date) & "/" & Year(Date))
'Count days in month

''Dys = DateAdd("m", 1, Dte) - Dte

Debug.Print Day(DateSerial(Year(Date), Month(Date), 0))
''EndofMonth = DateAdd("d", -1, DateAdd("m", 1, Dte))

'Add requisite sheets
Shts = Sheets.Count
Sheets.Add after:=Sheets(Shts), Count:=(Dys + 1)
' Loop through sheets
For i = Shts + 1 To Sheets.Count - 1
'Get date
Dy = DateValue(i - Shts & "/" & Month(Date) & "/" & Year(Date))
Select Case Weekday(Dy)
'If weekday
Case 2, 3, 4, 5, 6, 7
If ((Dy - Dte - Dys) = -1) Then
j = j + 1
Sheets(i).Name = "WEEK " & j
Else
Sheets(i).Name = Format(Dy, "ddd dd-mm-yy")
CountWeek = True
End If
Case Else
'If Sunday
j = j + 1
If CountWeek = True Then
Sheets(i).Name = "WEEK " & j
End If
End Select
Next
'Add total
Sheets(Sheets.Count).Name = UCase(Format(Dy, "MMM")) & " MONTH END TOTAL"

Application.ScreenUpdating = True
End Sub

Thank you for your help

Nurofen

[XLGibbs]

As I understand it you want to use the # of days in the month to add sheets, so you can just do:


Sub addsheets()
Dim lastday int, ws as worksheet, mydate as date,j as int, i as int,checkday as date

mydate = dateserial(year(date),month(date),1)

lastday = dateserial(year(dateadd("m",1,mydate),month(dateadd("m",1,0)

shtct = Thisworkbook.sheets.count
j=1
for i = 1 to lastday
'increment the date by 1 day using i
checkdate = dateserial(year(mydate),month(mydate),i)
'if it is sunday, do the below, otherwise, it is a weekday
If Weekday(checkdate) = 7 Then
Sheets.Add After: = Sheets.Count
ActiveWorksheet.Name= "WEEK " & j
j= j+ 1
Else ''if weekday do the below
Sheets.Add After: = Sheets.Count
ActiveWorksheet.Name = format(checkdate,"dd-mm-yy")
End if
'once done add the month end sheet
Sheets.Add After: = Sheets.Count
ActiveWorksheet.Name = format(checkdate,"MMM") & " MONTH END"

End sub


Yours was failing because my code assigned the last day number to a variable not in your code, and you didn't adjust anything else other than adding that line. You removed your own dys variable, so the code wouldnt do anything where that variable was used because it was null.

XLD's code was a debug.print statement and would only return the day to the immediate window so you could see how it worked. it is a standard testing practice..something you should be familiar with if you are going to code in VBA.

My solution above is a little shorter, and hasn't been tested, but use it as a suggestion to move forward.

[Bob Phillips]

day(dateserial(year(dte), month(dte),0)

would produce 30 where variable dte = 10/1/2007 because it would be the last day of september. unless I am mistaken.

No that was my mistake (not the missing trailing ), that was yours), I meant



day(dateserial(year(dte), month(dte)+1,0))


still simpler IMO

[Nurofen]

Hi Xld,XlGibbs

Thank you both for your help.

The following lines appear in red when insert the code, understanding that the code has not been tested. i'm not very good at understanding how to write code but I know a little to find the code needed.



Sub addsheets()
Dim lastday int, ws As worksheet, mydate As Date,j As int, i As int,checkday As Date

mydate = dateserial(year(date),month(date),1)

lastday = dateserial(year(dateadd("m",1,mydate),month(dateadd("m",1,0)

shtct = Thisworkbook.sheets.count
j=1
For i = 1 To lastday
'increment the date by 1 day using i
checkdate = dateserial(year(mydate),month(mydate),i)
'if it is sunday, do the below, otherwise, it is a weekday
If Weekday(checkdate) = 7 Then
Sheets.Add After: = Sheets.Count
ActiveWorksheet.Name= "WEEK " & j
j= j+ 1
Else ''if weekday do the below
Sheets.Add After: = Sheets.Count
ActiveWorksheet.Name = format(checkdate,"dd-mm-yy")
End If
'once done add the month end sheet
Sheets.Add After: = Sheets.Count
ActiveWorksheet.Name = format(checkdate,"MMM") & " MONTH END"

End Sub

I also tired your code Xld but again it only brings up Dec End Month Total

day(dateserial(year(dte), month(dte)+1,0))


Thank you again for your time :help


Nurofen

[Bob Phillips]

That depends upon what you have in dte.

For thr other, try this



Sub addsheets()
Dim lastday As Integer, ws As Worksheet, mydate As Date
Dim j As Integer, i As Integer, checkday As Date

mydate = DateSerial(Year(Date), Month(Date), 1)

lastday = DateSerial(Year(DateAdd("m", 1, mydate)), Month(DateAdd("m", 1)), 0)

[Nurofen]

Hi Xld,


That depends upon what you have in dte.

I thought that dte had whatever the computer date was set to, is that not right? I just a little lost sorry.:dunno



It stop's at DateAdd

Complier Error:
Argument not optional

Sub addsheets()
Dim lastday As Integer, ws As Worksheet, mydate As Date
Dim j As Integer, i As Integer, checkday As Date

mydate = DateSerial(Year(Date), Month(Date), 1)

lastday = DateSerial(Year(DateAdd("m", 1, mydate)), Month(DateAdd("m", 1)), 0)

shtct = ThisWorkbook.Sheets.Count
j = 1
For i = 1 To lastday
'increment the date by 1 day using i
checkdate = DateSerial(Year(mydate), Month(mydate), i)
'if it is sunday, do the below, otherwise, it is a weekday
If Weekday(checkdate) = 7 Then
Sheets.Add After:=Sheets.Count
ActiveWorksheet.Name = "WEEK " & j
j = j + 1
Else ''if weekday do the below
Sheets.Add After:=Sheets.Count
ActiveWorksheet.Name = Format(checkdate, "dd-mm-yy")
End If
'once done add the month end sheet
Sheets.Add After:=Sheets.Count
ActiveWorksheet.Name = Format(checkdate, "MMM") & " MONTH END"

End Sub


Thank you taking time to help


Nurofen

[XLGibbs]

My bad, typo..

Dim lastday as int,

instead of lastday int

[Bob Phillips]

And integre not int (many times)

[Bob Phillips]

I thought that dte had whatever the computer date was set to, is that not right? I just a little lost sorry.:dunno

No that is Date not dte. Dte would be a variable in your code.


It stop's at DateAdd

Complier Error:
Argument not optional

Sub addsheets()
Dim lastday As Integer, ws As Worksheet, mydate As Date
Dim j As Integer, i As Integer, checkday As Date

mydate = DateSerial(Year(Date), Month(Date), 1)

lastday = DateSerial(Year(DateAdd("m", 1, mydate)), Month(DateAdd("m", 1)), 0)

I missed another error in that code, try



lastday = DateSerial(Year(DateAdd("m", 1, mydate)), Month(DateAdd("m", 1, mydate)), 0)

[Nurofen]

Hi Xld,

complier Error:
Variable not defined
shtct = ThisWorkbook.Sheets.Count
Ive changed the code it gives me 31 days but not Week Tab after:

-1 to 1
Sub MyMacro10()
Dim Dte As Date, Dy As Date
Dim i As Long, j As Long, Dys As Long
Dim CountWeek As Boolean
Dim Shts As Long

Application.ScreenUpdating = False


'Get 1st of month
Dte = DateValue("1/" & Month(Date) & "/" & Year(Date))
'Count days in month
Dys = DateAdd("m", 1, Dte) - Dte
'Add requisite sheets
Shts = Sheets.Count
Sheets.Add after:=Sheets(Shts), Count:=(Dys + 1)
' Loop through sheets
For i = Shts + 1 To Sheets.Count - 1
'Get date
Dy = DateValue(i - Shts & "/" & Month(Date) & "/" & Year(Date))
Select Case Weekday(Dy)
'If weekday
Case 2, 3, 4, 5, 6, 7
If ((Dy - Dte - Dys) = 1) Then
j = j + 1
Sheets(i).Name = "WEEK " & j
Else
Sheets(i).Name = Format(Dy, "ddd dd-mm-yy")
CountWeek = True
End If
Case Else
'If Sunday
j = j + 1
If CountWeek = True Then
Sheets(i).Name = "WEEK " & j
End If
End Select
Next
'Add total
Sheets(Sheets.Count).Name = UCase(Format(Dy, "MMM")) & " MONTH END TOTAL"

Application.ScreenUpdating = True
End Sub

[XLGibbs]

It stop's at DateAdd

Complier Error:
Argument not optional



Sub addsheets()
Dim lastday As Integer, ws As Worksheet, mydate As Date
Dim j As Integer, i As Integer, checkday As Date,shtct as integer

mydate = DateSerial(Year(Date), Month(Date), 1)

lastday = DateSerial(Year(DateAdd("m", 1, mydate)), Month(DateAdd("m", 1,Mydate)), 0)

shtct = ThisWorkbook.Sheets.Count
j = 1
For i = 1 To lastday
'increment the date by 1 day using i
checkdate = DateSerial(Year(mydate), Month(mydate), i)
'if it is sunday, do the below, otherwise, it is a weekday
If Weekday(checkdate) = 7 Then
Sheets.Add After:=Sheets.Count
ActiveWorksheet.Name = "WEEK " & j
j = j + 1
Else ''if weekday do the below
Sheets.Add After:=Sheets.Count
ActiveWorksheet.Name = Format(checkdate, "dd-mm-yy")
End If
'once done add the month end sheet
Sheets.Add After:=Sheets.Count
ActiveWorksheet.Name = Format(checkdate, "MMM") & " MONTH END"

End Sub

Thank you taking time to help


Nurofen[/quote]

Stick to either your code, or my code and be diligent in not simply just cut and pasting. Try to follow along and understand what is happending. A

Arguments to dateadd are interval type,interval,date. The missing argument was the date...my bad.

If syntax is offered, you need to be sure to apply it to your code diligently and make sure that variable names are consistent and used properly.


As far as the shtct = Sheets.Count, I forgot to declare shtct at the top.

Variable not declared means that you have DIM the variable before that line.


Changes to the code in bold above.

[Nurofen]

Thank you for your help XLGibbs,

I being confused, I'm not an expert and i'm not being rude. I can not make the code you created work.

I have just run the code you have edited and i have another complier error.

The code i'm working with is ok and i was asking for help to change it so it would include the 31st.

I'm sorry if you think i'm not following along, but i don't know how to change your code to meet my needs.



Nurofen

[Bob Phillips]

Where are you based in the UK Nuro?

[XLGibbs]

That is okay, and I didn't mean to imply you were being rude or anything.

What was the error mine produced? I hadn't tested it, which I should have.
Sub addsheets()
Dim lastday As Long, ws As Worksheet, mydate As Date
Dim j As Integer, i As Integer, checkday As Date, shtct As Integer

mydate = DateSerial(Year(Date), Month(Date), 1)

lastday = Day(DateSerial(Year(DateAdd("m", 1, mydate)), Month(DateAdd("m", 1, mydate)), 0))

shtct = ThisWorkbook.Sheets.Count
j = 1
For i = 1 To lastday
'increment the date by 1 day using i
checkdate = DateSerial(Year(mydate), Month(mydate), i)
'if it is sunday, do the below, otherwise, it is a weekday
If Weekday(checkdate) = 7 Then
Sheets.Add After:=Sheets(shtct)
ActiveSheet.Name = "WEEK " & j
j = j + 1
Else ''if weekday do the below
Sheets.Add After:=Sheets(shtct)
ActiveSheet.Name = Format(checkdate, "dd-mm-yy")

End If
shtct = shtct + 1
'once done add the month end sheet

Next i
Sheets.Add After:=Sheets.Add(After:=Sheets(shtct))
ActiveSheet.Name = Format(checkdate, "MMM") & " MONTH END"

End Sub


The above is tested and works exactly as you need.

[Nurofen]

Hi Xld, XLGibbs

I'm from Leicester in the UK Xld.


I have run the code it does work but the Tab before the Month End Total is sheet134 and should appear as Week5 anyway to solve this?


That is okay, and I didn't mean to imply you were being rude or anything. No problem just don't want you to think i'm trying to get you to do the work mate.


I'm reading a book called Excel Programming Weekend Crash Course so i am trying to learn. It just a little hard when no one is giving you guidence to say you are do this right or your doing that wrong.

I kept getting complier error casue I had the Option Explicit option ticked.

XLGibbs the error I got was complier Error:
Variable not defined
checkdate = DateSerial(Year(mydate), Month(mydate), i)
Thank you both for taking you time to help me

Nurofen

[Bob Phillips]

So declare it



Dim checkdate As date


See Leicester have gotten rid of the dross up top!

[Nurofen]

Sorry for not being clear I was answering the questioned asked by XLGibbs
about the error.


The problem is :



I have run the code it does work but the Tab before the Month End Total is sheet134 and should appear as Week5 anyway to solve this?

dross up top????

[Bob Phillips]

Megson!

[Nurofen]

Sorry Xld,

Megson....Football not my thing.

[XLGibbs]

Option Explicit
Sub addsheets()
Dim lastday As Long, ws As Worksheet, mydate As Date
Dim j As Integer, i As Integer, checkday As Date, shtct As Integer
Dim checkdate As Date
mydate = DateSerial(Year(Date), Month(Date), 1)

lastday = Day(DateSerial(Year(DateAdd("m", 1, mydate)), Month(DateAdd("m", 1, mydate)), 0))

shtct = ThisWorkbook.Sheets.Count
j = 1
For i = 1 To lastday
shtct = ThisWorkbook.Sheets.Count

'increment the date by 1 day using i
checkdate = DateSerial(Year(mydate), Month(mydate), i)
'if it is sunday, do the below, otherwise, it is a weekday
If Weekday(checkdate) = 7 Then
Sheets.Add After:=Sheets(shtct)
ActiveSheet.Name = "WEEK " & j
j = j + 1
Sheets.Add After:=Sheets(shtct + 1)
ActiveSheet.Name = Format(checkdate, "dd-mm-yy")
shtct = shtct + 1
Else ''if weekday do the below
Sheets.Add After:=Sheets(shtct)
ActiveSheet.Name = Format(checkdate, "dd-mm-yy")

End If

'once done add the month end sheet

Next i
shtct = Sheets.Count
On Error Resume Next
Sheets.Add After:=Sheets(shtct)
ActiveSheet.Name = "WEEK " & j
On Error GoTo 0

shtct = Sheets.Count
Sheets.Add After:=Sheets(shtct)
ActiveSheet.Name = Format(checkdate, "MMM") & " MONTH END"

End Sub




Sorry about the flubs! Here is one that is much nicer. I noticed the other one would skip a day, but this works perfectly.

[Nurofen]

Hi XLGibbs,

Thank you for taking time to work on this code for me, The code works but it also adds Sunday.

The sheets need to be for Example November month:
Thu Fri Sat Week1 Mon Tue Wed Thur Fri Sat Week2 and so on.

Your code:
Thu Fri Week1 Sat Sun Mon Tue Wed Thu Fri Week2 Sat Sun annd so on.

I want the Week Tab after the Sat and don't want a Sunday tab

Thank for the time spent

Nurofen

[XLGibbs]

Option Explicit
Sub addsheets()
Dim lastday As Long, ws As Worksheet, mydate As Date
Dim j As Integer, i As Integer, checkday As Date, shtct As Integer
Dim checkdate As Date
mydate = DateSerial(Year(Date), Month(Date), 1)

lastday = Day(DateSerial(Year(DateAdd("m", 1, mydate)), Month(DateAdd("m", 1, mydate)), 0))

shtct = ThisWorkbook.Sheets.Count
j = 1
For i = 1 To lastday
shtct = ThisWorkbook.Sheets.Count

'increment the date by 1 day using i
checkdate = DateSerial(Year(mydate), Month(mydate), i)
'if it is sunday, do the below, otherwise, it is a weekday
If Weekday(checkdate) = 7 Then
Sheets.Add After:=Sheets(shtct)
ActiveSheet.Name = "WEEK " & j
j = j + 1
'the below lines add Sunday if needed
'Sheets.Add After:=Sheets(shtct + 1)
'ActiveSheet.Name = Format(checkdate, "dd-mm-yy")

Else ''if weekday do the below
Sheets.Add After:=Sheets(shtct)
ActiveSheet.Name = Format(checkdate, "dd-mm-yy")

End If

'once done add the month end sheet

Next i
shtct = Sheets.Count
On Error Resume Next
Sheets.Add After:=Sheets(shtct)
ActiveSheet.Name = "WEEK " & j
On Error GoTo 0

shtct = Sheets.Count
Sheets.Add After:=Sheets(shtct)
ActiveSheet.Name = Format(checkdate, "MMM") & " MONTH END"

End Sub



See the commented out lines above I got it working, then I noticed Sunday's were skipped and thought it was a mistake. Should be good to go for you now.

[Nurofen]

Hi XLGibbs,

It's changing the Saturdays to Week tabs and and keeping the Sunday Tab.

I need the Saturday Tabs and the Sunday Tabs to be Week Tabs


Sorry about this mate

Nurofen

[XLGibbs]

Change the weekday check to 1. I hadn't checked that aspect of it assuming your cutoff was = 7. Sunday is 1, Saturday is 7


If Weekday(Checkdate) = 1


and that will wrap it up.

[Nurofen]

Hi XLGibbs,

Thank you so much :friends: for taking time and helping. Works great.


Thank you



Nurofen

[XLGibbs]

My pleasure.