PDA

View Full Version : Solved: Adding Sheets By Day Order



Nurofen
09-11-2007, 11:22 AM
Hi all,

I need some help with changing code to meet my needs.
Example1(Masterstats) is what I start with every month (new)
Example2(AugStats) is what I would like to end up with after the code is run.

1) The code when run will provide sheets for the whole month but i have to change it every month for the next month is there a way to solve this?
2) Where Sunday appears I'd like to have them re-named to Week1 Total,Week2 Total and so until the end of the month
3) The sheet runs from 1st of the month to 30 or 31 of the month
so if the end of the month is Friday then a Week Total must go next and then a Month Total.

The code that I need to change every month:


sTemp = Str(iTarget) & "/1/" & Year(Now())


The whole code:


Private Sub CommandButton1_Click()

Dim J As Integer
Dim K As Integer
Dim sDay As String
Dim sTemp As String
Dim iTarget As Integer
Dim dBasis As Date

iTarget = 13
While (iTarget < 1) Or (iTarget > 12)
iTarget = Val(InputBox("Numeric month?"))
If iTarget = 0 Then Exit Sub
Wend

Application.ScreenUpdating = False
sTemp = Str(iTarget) & "/1/" & Year(Now())
dBasis = CDate(sTemp)

For J = 1 To 31
sDay = Format((dBasis + J - 1), "dddd mm-dd-yyyy")
If Month(dBasis + J - 1) = iTarget Then

If J <= Sheets.Count Then
If Left(Sheets(J).Name, 5) = "Sheet" Then
Sheets(J).Name = sDay
Else
Sheets.Add.Move after:=Sheets(Sheets.Count)
ActiveSheet.Name = sDay
End If
Else
Sheets.Add.Move after:=Sheets(Sheets.Count)
ActiveSheet.Name = sDay
End If
End If
Next J

For J = 1 To (Sheets.Count - 1)
For K = J + 1 To Sheets.Count
If Right(Sheets(J).Name, 10) > _
Right(Sheets(K).Name, 10) Then
Sheets(K).Move Before:=Sheets(J)
End If
Next K
Next J

Sheets(1).Activate
Application.ScreenUpdating = True
End Sub


If any one can help with this I will be very greatful
Thank you for you time

Nurofen

Bob Phillips
09-11-2007, 12:32 PM
There is no data in the AUgust workbook, which is a bit awkward to figure out.

The Master sheet just throws up #REF errors, which is not very helpful, it mnakes it hard to understand as this suggest it is linked to another workbook, but which.

What exactly is this all about? It's not cold-calling is it?

mdmackillop
09-11-2007, 12:38 PM
Here's some basic code. You'll need to tweak it to suit.
Option Explicit

Sub NewSheets()
Dim Dte As Date, Dy As Date
Dim i As Long, j As Long, Dys As Long
Dim CountWeek As Boolean
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
Sheets.Add Count:=(Dys - Sheets.Count + 1)
'Loop through sheets
For i = 1 To Dys
'Get date
Dy = DateValue(i & "/" & Month(Date) & "/" & Year(Date))
Select Case Weekday(Dy)
'If weekday
Case 2, 3, 4, 5, 6, 7
Sheets(i).Name = Format(Dy, "ddd dd-mm-yy")
CountWeek = True
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
End Sub

Nurofen
09-11-2007, 12:47 PM
Mdmackillop,

You are the man, Thank you so much that saves me so much time.

I have another couple of qustions.

How do I get the code to start after the first 5 sheets as they hold all my data?

1) I want be able to have a front sheet with a popup box which will let me delete rows by the names and add rows by names when agents leave and new ones join according to which team they are in.
2) Is there a code I can run that will add all the day totals to the week Total and the weeks to the month end total.
3) I need to also protect colums Total, Appt Per, Call Banding, Total Sales, Conv%, Pipp Banding after all the sheets have been copied over.

If any of these question have been answered before please point me in the right direction as I can not find them..

Again Mdmackillop your the man

Thank you very much

mdmackillop
09-11-2007, 04:14 PM
Here's a modification to preserve the first 5 sheets.
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
Sheets(i).Name = Format(Dy, "ddd dd-mm-yy")
CountWeek = True
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
End Sub

Nurofen
09-11-2007, 10:39 PM
Thanks again Mdmackillop.

You are the man:bow:

Works grest

Nurofen