Johnis2Deezy
New Member
- Joined
- Feb 17, 2014
- Messages
- 7
I am trying to write a macro that will create a report that can be filled in for an entire year with a tab per week, tab for a summary for the month, and tab for summary of each quarter. The reason for this is that the report is probably going to have elements added later on. So, rather than adding something new to each spreadsheet, I would add it to the template and then recreate the report. Ive attached the file, and if you run the macro you can see whats going on. My question is,
i have a ton of repeated code, especially in the case statements. I have been trying to figure out how i could use more loops but i think i am to far in the hole and i need to clean up the code i already have. Does anybody have any suggestions?
heres the file
i have a ton of repeated code, especially in the case statements. I have been trying to figure out how i could use more loops but i think i am to far in the hole and i need to clean up the code i already have. Does anybody have any suggestions?
heres the file
Code:
Sub Create_Spreadsheets()
Dim Tmp As String
Dim tmp2 As String
Dim Tmp3 As String
Dim Dtname As Date
Dim i As Integer
Dim ii As Integer
Dim iii As Integer
Dim e As Integer
Dim wbad(4) As String, werror(4) As String, wgood(4) As String, wprep(4) As String
Dim wksht As String
Tmp = Sheets(1).Name
tmp2 = Sheets(2).Name
Tmp3 = Sheets(3).Name
Dtname = #2/2/2014#
ii = 1
iii = 1
e = 0
'Week Tabs
For i = 1 To 52
Worksheets(Tmp).Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "WK" & i & " " & Format(Dtname, "mmm")
Sheets(Sheets.Count).Range("B1").Value = "Week #" & i
' get link cell names
wksht = Sheets(Sheets.Count).Name
wbad(e) = "='" & wksht & "'!I13"
werror(e) = "='" & wksht & "'!I15"
wgood(e) = "='" & wksht & "'!I17"
wprep(e) = "='" & wksht & "'!I19"
'dates
Sheets(Sheets.Count).Range("b8").Activate
For a = 0 To 6
ActiveCell.Value = Dtname
ActiveCell.Offset(0, 1).Activate
Dtname = Dtname + 1
Next
e = e + 1
'P tabs and Q tabs
Select Case i
Case 4
Worksheets(tmp2).Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "P" & ii & " " & " Feb"
Sheets(Sheets.Count).Range("B1").Value = "Period #" & ii
Sheets(Sheets.Count).Tab.ColorIndex = 6
' header names
Sheets(Sheets.Count).Range("b8").Activate
For a = n1 To n2
ActiveCell.Value = "WK " & a
ActiveCell.Offset(0, 1).Activate
Next
ii = ii + 1
' link cells
Sheets(Sheets.Count).Range("B13").Activate
e = 0
For e = 0 To 3
ActiveCell.Value = wbad(e)
ActiveCell.Offset(2, 0).Value = werror(e)
ActiveCell.Offset(4, 0).Value = wgood(e)
ActiveCell.Offset(6, 0).Value = wprep(e)
ActiveCell.Offset(0, 1).Activate
Next
e = 0
Case 9
Worksheets(tmp2).Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "P" & ii & " Mar"
Sheets(Sheets.Count).Range("B1").Value = "Period #" & ii
Sheets(Sheets.Count).Tab.ColorIndex = 6
' header names
Sheets(Sheets.Count).Range("b8").Activate
For a = 5 To 9
ActiveCell.Value = "WK " & a
ActiveCell.Offset(0, 1).Activate
Next
ii = ii + 1
' link cells
Sheets(Sheets.Count).Range("B13").Activate
e = 0
For e = 0 To 4
ActiveCell.Value = wbad(e)
ActiveCell.Offset(2, 0).Value = werror(e)
ActiveCell.Offset(4, 0).Value = wgood(e)
ActiveCell.Offset(6, 0).Value = wprep(e)
ActiveCell.Offset(0, 1).Activate
Next
e = 0
Case 13
Worksheets(tmp2).Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "P" & ii & " Apr"
Sheets(Sheets.Count).Range("B1").Value = "Period #" & ii
Sheets(Sheets.Count).Tab.ColorIndex = 6
' header names
Sheets(Sheets.Count).Range("b8").Activate
For a = 10 To 13
ActiveCell.Value = "WK " & a
ActiveCell.Offset(0, 1).Activate
Next
ii = ii + 1
' link cells
Sheets(Sheets.Count).Range("B13").Activate
e = 0
For e = 0 To 3
ActiveCell.Value = wbad(e)
ActiveCell.Offset(2, 0).Value = werror(e)
ActiveCell.Offset(4, 0).Value = wgood(e)
ActiveCell.Offset(6, 0).Value = wprep(e)
ActiveCell.Offset(0, 1).Activate
Next
e = 0
Worksheets(Tmp3).Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "Q" & iii
Sheets(Sheets.Count).Range("B1").Value = "Quarter #" & iii
Sheets(Sheets.Count).Tab.ColorIndex = 8
iii = iii + 1
Case 17
Worksheets(tmp2).Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "P" & ii & " May"
Sheets(Sheets.Count).Range("B1").Value = "Period #" & ii
Sheets(Sheets.Count).Tab.ColorIndex = 6
' header names
Sheets(Sheets.Count).Range("b8").Activate
For a = 14 To 17
ActiveCell.Value = "WK " & a
ActiveCell.Offset(0, 1).Activate
Next
ii = ii + 1
' link cells
Sheets(Sheets.Count).Range("B13").Activate
e = 0
For e = 0 To 3
ActiveCell.Value = wbad(e)
ActiveCell.Offset(2, 0).Value = werror(e)
ActiveCell.Offset(4, 0).Value = wgood(e)
ActiveCell.Offset(6, 0).Value = wprep(e)
ActiveCell.Offset(0, 1).Activate
Next
e = 0
Case 22
Worksheets(tmp2).Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "P" & ii & " Jun"
Sheets(Sheets.Count).Range("B1").Value = "Period #" & ii
Sheets(Sheets.Count).Tab.ColorIndex = 6
' header names
Sheets(Sheets.Count).Range("b8").Activate
For a = 18 To 22
ActiveCell.Value = "WK " & a
ActiveCell.Offset(0, 1).Activate
Next
ii = ii + 1
' link cells
Sheets(Sheets.Count).Range("B13").Activate
e = 0
For e = 0 To 4
ActiveCell.Value = wbad(e)
ActiveCell.Offset(2, 0).Value = werror(e)
ActiveCell.Offset(4, 0).Value = wgood(e)
ActiveCell.Offset(6, 0).Value = wprep(e)
ActiveCell.Offset(0, 1).Activate
Next
e = 0
Case 26
Worksheets(tmp2).Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "P" & ii & " Jul"
Sheets(Sheets.Count).Range("B1").Value = "Period #" & ii
Sheets(Sheets.Count).Tab.ColorIndex = 6
' header names
Sheets(Sheets.Count).Range("b8").Activate
For a = 23 To 26
ActiveCell.Value = "WK " & a
ActiveCell.Offset(0, 1).Activate
Next
ii = ii + 1
' link cells
Sheets(Sheets.Count).Range("B13").Activate
e = 0
For e = 0 To 3
ActiveCell.Value = wbad(e)
ActiveCell.Offset(2, 0).Value = werror(e)
ActiveCell.Offset(4, 0).Value = wgood(e)
ActiveCell.Offset(6, 0).Value = wprep(e)
ActiveCell.Offset(0, 1).Activate
Next
e = 0
Worksheets(Tmp3).Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "Q" & iii
Sheets(Sheets.Count).Range("B1").Value = "Quarter #" & iii
Sheets(Sheets.Count).Tab.ColorIndex = 8
iii = iii + 1
Case 30
Worksheets(tmp2).Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "P" & ii & " Aug"
Sheets(Sheets.Count).Range("B1").Value = "Period #" & ii
Sheets(Sheets.Count).Tab.ColorIndex = 6
' header names
Sheets(Sheets.Count).Range("b8").Activate
For a = 27 To 30
ActiveCell.Value = "WK " & a
ActiveCell.Offset(0, 1).Activate
Next
ii = ii + 1
' link cells
Sheets(Sheets.Count).Range("B13").Activate
e = 0
For e = 0 To 3
ActiveCell.Value = wbad(e)
ActiveCell.Offset(2, 0).Value = werror(e)
ActiveCell.Offset(4, 0).Value = wgood(e)
ActiveCell.Offset(6, 0).Value = wprep(e)
ActiveCell.Offset(0, 1).Activate
Next
e = 0
Case 35
Worksheets(tmp2).Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "P" & ii & " Sep"
Sheets(Sheets.Count).Range("B1").Value = "Period #" & ii
Sheets(Sheets.Count).Tab.ColorIndex = 6
' header names
Sheets(Sheets.Count).Range("b8").Activate
For a = 31 To 35
ActiveCell.Value = "WK " & a
ActiveCell.Offset(0, 1).Activate
Next
ii = ii + 1
' link cells
Sheets(Sheets.Count).Range("B13").Activate
e = 0
For e = 0 To 4
ActiveCell.Value = wbad(e)
ActiveCell.Offset(2, 0).Value = werror(e)
ActiveCell.Offset(4, 0).Value = wgood(e)
ActiveCell.Offset(6, 0).Value = wprep(e)
ActiveCell.Offset(0, 1).Activate
Next
e = 0
Case 39
Worksheets(tmp2).Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "P" & ii & " Oct"
Sheets(Sheets.Count).Range("B1").Value = "Period #" & ii
Sheets(Sheets.Count).Tab.ColorIndex = 6
' header names
Sheets(Sheets.Count).Range("b8").Activate
For a = 36 To 39
ActiveCell.Value = "WK " & a
ActiveCell.Offset(0, 1).Activate
Next
ii = ii + 1
' link cells
Sheets(Sheets.Count).Range("B13").Activate
e = 0
For e = 0 To 3
ActiveCell.Value = wbad(e)
ActiveCell.Offset(2, 0).Value = werror(e)
ActiveCell.Offset(4, 0).Value = wgood(e)
ActiveCell.Offset(6, 0).Value = wprep(e)
ActiveCell.Offset(0, 1).Activate
Next
e = 0
Worksheets(Tmp3).Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "Q" & iii
Sheets(Sheets.Count).Range("B1").Value = "Quarter #" & iii
Sheets(Sheets.Count).Tab.ColorIndex = 8
iii = iii + 1
Case 43
Worksheets(tmp2).Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "P" & ii & " Nov"
Sheets(Sheets.Count).Range("B1").Value = "Period #" & ii
Sheets(Sheets.Count).Tab.ColorIndex = 6
' header names
Sheets(Sheets.Count).Range("b8").Activate
For a = 40 To 43
ActiveCell.Value = "WK " & a
ActiveCell.Offset(0, 1).Activate
Next
ii = ii + 1
' link cells
Sheets(Sheets.Count).Range("B13").Activate
e = 0
For e = 0 To 3
ActiveCell.Value = wbad(e)
ActiveCell.Offset(2, 0).Value = werror(e)
ActiveCell.Offset(4, 0).Value = wgood(e)
ActiveCell.Offset(6, 0).Value = wprep(e)
ActiveCell.Offset(0, 1).Activate
Next
e = 0
Case 48
Worksheets(tmp2).Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "P" & ii & " Dec"
Sheets(Sheets.Count).Range("B1").Value = "Period #" & ii
Sheets(Sheets.Count).Tab.ColorIndex = 6
' header names
Sheets(Sheets.Count).Range("b8").Activate
For a = 44 To 48
ActiveCell.Value = "WK " & a
ActiveCell.Offset(0, 1).Activate
Next
ii = ii + 1
' link cells
Sheets(Sheets.Count).Range("B13").Activate
e = 0
For e = 0 To 4
ActiveCell.Value = wbad(e)
ActiveCell.Offset(2, 0).Value = werror(e)
ActiveCell.Offset(4, 0).Value = wgood(e)
ActiveCell.Offset(6, 0).Value = wprep(e)
ActiveCell.Offset(0, 1).Activate
Next
e = 0
Case 52
Worksheets(tmp2).Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "P" & ii & " Jan"
Sheets(Sheets.Count).Range("B1").Value = "Period #" & ii
Sheets(Sheets.Count).Tab.ColorIndex = 6
' header names
Sheets(Sheets.Count).Range("b8").Activate
For a = 49 To 52
ActiveCell.Value = "WK " & a
ActiveCell.Offset(0, 1).Activate
Next
ii = ii + 1
' link cells
Sheets(Sheets.Count).Range("B13").Activate
e = 0
For e = 0 To 3
ActiveCell.Value = wbad(e)
ActiveCell.Offset(2, 0).Value = werror(e)
ActiveCell.Offset(4, 0).Value = wgood(e)
ActiveCell.Offset(6, 0).Value = wprep(e)
ActiveCell.Offset(0, 1).Activate
Next
e = 0
Worksheets(Tmp3).Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "Q" & iii
Sheets(Sheets.Count).Range("B1").Value = "Quarter #" & iii
Sheets(Sheets.Count).Tab.ColorIndex = 8
iii = iii + 1
End Select
Next
End Sub