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
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