Solved: Month building code issue
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
[vba]
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
[/vba]
Thank you for your time
Nurofen