Quantcast
Channel: Excel Help Forum - Excel Programming / VBA / Macros
Viewing all articles
Browse latest Browse all 50099

Writing a Grading WS sub to find stats (mean, stdev, etc. for data) and put it into new ws

$
0
0
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.

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 Sub


Any thoughts or guidance would be greatly appreciated.
Attached Files

Viewing all articles
Browse latest Browse all 50099

Trending Articles