N
Naz75
Hi all,
My problem is that I need Week Totals to calculate the day dated sheets
before them and the Monthly total to calculate the Week Totals. Every month
the workbook will be different due to amount of days and dates in each
month. I was hoping if someone could help me out with code to make this work.
The ranges are B6:E24, G6:H24, K624 (top team)
The ranges are B28:E49, G28:H49, K2849 (bottom team)
The ranges can also change if agents are added or leave
The code I use to build the Monthly sheet, copy the master and zoom
Sub NewSheets()
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 = False
Hope I have been clear.
Thank you for your time
Naz75
My problem is that I need Week Totals to calculate the day dated sheets
before them and the Monthly total to calculate the Week Totals. Every month
the workbook will be different due to amount of days and dates in each
month. I was hoping if someone could help me out with code to make this work.
The ranges are B6:E24, G6:H24, K624 (top team)
The ranges are B28:E49, G28:H49, K2849 (bottom team)
The ranges can also change if agents are added or leave
The code I use to build the Monthly sheet, copy the master and zoom
Sub NewSheets()
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 = False
Hope I have been clear.
Thank you for your time
Naz75