Hi,
I am working on an excel grade book that automates many of the repetitive tasks in generating certain forms and statistics from a set of data. I am looking for a way to write a sub that will calculate the mean, median, stdev, and variance for each listed assignment in the workbook, and create a new sheet to put this data into. There are two sections of the class, so I am looking to create three new worksheets with the sub, one for "Section 001," one for "Section 002," and one for "All." I want to label the worksheets "001Stats," "002Stats," and "AllStats," respectively. My code for the previous subs that perform related functions are listed, and the file I am working with is below. There are several other subs in the file, and these are the subs that I think may need to come first before writing another sub that calculates the stats and puts them in new worksheets.
Any thoughts or guidance would be greatly appreciated.
I am working on an excel grade book that automates many of the repetitive tasks in generating certain forms and statistics from a set of data. I am looking for a way to write a sub that will calculate the mean, median, stdev, and variance for each listed assignment in the workbook, and create a new sheet to put this data into. There are two sections of the class, so I am looking to create three new worksheets with the sub, one for "Section 001," one for "Section 002," and one for "All." I want to label the worksheets "001Stats," "002Stats," and "AllStats," respectively. My code for the previous subs that perform related functions are listed, and the file I am working with is below. There are several other subs in the file, and these are the subs that I think may need to come first before writing another sub that calculates the stats and puts them in new worksheets.
Code:
Sub sectionnumberentry()
'
' sectionnumberentry Macro
'
Dim a As Integer
Dim b As Integer
Dim Students As Integer
Dim Midterm001 As Integer
Dim Midterm002 As Integer
Dim section As String
'Midterm001 = Range(Range("A6"), Range("A6").End("Midterm 001")).Count
NAssig = Range(Range("C6"), Range("C6").End(xlToRight)).Count
For b = 1 To NAssig + 2
If UCase(Cells(6, b).Value) = "MIDTERM 001 " Then
Exit For
End If
Next b
Columns("C:C").Select
Selection.Insert Shift:=xlToRight
Students = Range(Range("A7"), Range("A7").End(xlDown)).Count
Range("C6").Value = "Section"
For a = 1 To Students
If Cells(a + 6, b + 1).Value <> 0 Then
Cells(a + 6, 3).Value = "Section 1"
ElseIf Cells(a + 6, b + 2).Value <> 0 Then Cells(a + 6, 3).Value = "Section 2"
Else: section = InputBox("Please input section number", "Section is Missing", "Section 1")
Cells(a + 6, 3).Value = section
End If
'What if Midterm001 moves????
' Range("C7:C117").FormulaR1C1 = "=IF(RC[6]="0",2,1)"
Next a
End Sub
Sub BreakBySection()
Dim x As Integer
Dim erow As Integer
Dim row As Integer
Dim Section1 As Integer
Dim Section2 As Integer
Dim Students As Integer
Dim Length As Integer
Worksheets("Grades").Select
Section1 = 2
Section2 = 2
Students = Range(Range("A7"), Range("A7").End(xlDown)).Count
Length = Range(Range("A6"), Range("A6").End(xlToRight)).Count
'Add Worksheets
'Sheets.Add.Name = "Section002"
'Sheets.Add.Name = "Section001"
Worksheets.Add after:=Worksheets("Grades")
ActiveSheet.Name = "Section01"
Worksheets("Grades").Select
Worksheets("Grades").Range(Cells(6, 1), Cells(6, Length)).Select
Selection.Copy
Sheets("Section01").Select
Worksheets("Section01").Range(Cells(1, 1), Cells(1, Length)).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Worksheets("Section01").Range(Cells(1, 1), Cells(1, Length)).Font.Color = vbRed
Worksheets("Section01").Range(Cells(1, 1), Cells(1, Length)).Font.Bold = True
Worksheets.Add after:=Worksheets("Section01")
ActiveSheet.Name = "Section02"
Worksheets("Grades").Select
Worksheets("Grades").Range(Cells(6, 1), Cells(6, Length)).Select
Selection.Copy
Sheets("Section02").Select
Worksheets("Section02").Range(Cells(1, 1), Cells(1, Length)).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Worksheets("Section02").Range(Cells(1, 1), Cells(1, Length)).Font.Color = vbRed
Worksheets("Section02").Range(Cells(1, 1), Cells(1, Length)).Font.Bold = True
x = 6
'Start Loop
For row = 7 To Students
If Worksheets("Grades").Cells(row, 3).Value = "Section 1" Then
Worksheets("Grades").Select
Worksheets("Grades").Range(Cells(row, 1), Cells(row, Length)).Select
Selection.Copy
Sheets("Section01").Select
Worksheets("Section01").Range(Cells(Section1, 1), Cells(Section1, Length)).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Section1 = Section1 + 1
Else
Worksheets("Grades").Select
Worksheets("Grades").Range(Cells(row, 1), Cells(row, Length)).Select
Selection.Copy
Sheets("Section02").Select
Worksheets("Section02").Range(Cells(Section2, 1), Cells(Section2, Length)).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Section2 = Section2 + 1
End If
Next row
Do While Cells(x, 1) <> ""
If Cells(x, 1) = "0.0" Then
'Copy row with "0.0"
Worksheets("Grades").Rows(x).Copy
'select data to section 001 Worksheet
Worksheets("Section01").Activate
'first empty row
erow = Worksheets("Section01").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).row
'paste data
ActiveSheet.Paste Destination:=Worksheets("Section001").Rows(erow)
End If
Worksheets("Grades").Activate
x = x + 1
Loop
Sheets("Section01").Select
Cells.EntireColumn.AutoFit
Sheets("Section02").Select
Cells.EntireColumn.AutoFit
End SubAny thoughts or guidance would be greatly appreciated.