Best way to summarise this data / best table format

[wheatley]

Hi there,

Am trying to create a mark book/tracking workbook for my students. I have a sheet set up as per the attached screenshot.

I want a summary tab to see just the percentage column across the assessments so I can easily do a graph/work out averages etc. What's the best way to do this so it's up to date regardless of how many extra assessments I add through the year? Thanks.

 

[mumps]

I would set up a sheet named "Summary" that looks like this;

Student ID	Family Name	First Name	Assess. 1 %	Assess. 2 %	Assess. 3 %	Assess. 4 %	Assess. 5 %	Assess. 6 %
1	a	aa
2	b	bb
3	c	cc
4	d	dd
5	e	ee
6	f	ff
7	g	gg

Then I would run this macro each time you want to update the Summary sheet. Change the sheet names (in red) to suit your needs.

Sub UpdateSummary()
    Application.ScreenUpdating = False
    Dim LastRow As Long, srcWS As Worksheet, desWS As Worksheet, lCol As Long, lCol2 As Long, x As Long, y As Long: y = 4
    Set srcWS = Sheets("Data")
    Set desWS = Sheets("Summary")
    LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    lCol = srcWS.Cells(2, Columns.Count).End(xlToLeft).Column
    lCol2 = desWS.Cells(1, Columns.Count).End(xlToLeft).Column
    If desWS.Range("D2") <> "" Then
        desWS.Range("D2", Range("D" & Rows.Count).End(xlUp)).Resize(, lCol2 - 3).ClearContents
    End If
    For x = 5 To lCol Step 3
        desWS.Cells(2, y).Resize(LastRow - 2).Value = srcWS.Cells(3, x).Resize(LastRow - 2).Value
        y = y + 1
    Next x
    Application.ScreenUpdating = True
End Sub

 

[mumps]

Sorry. Try this revised version:

Sub UpdateSummary()
    Application.ScreenUpdating = False
    Dim LastRow As Long, LastRow2 As Long, srcWS As Worksheet, desWS As Worksheet, lCol As Long, lCol2 As Long, x As Long, y As Long: y = 4
    Set srcWS = Sheets("Data")
    Set desWS = Sheets("Summary")
    LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    lCol = srcWS.Cells(2, Columns.Count).End(xlToLeft).Column
    LastRow2 = desWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    lCol2 = desWS.Cells(1, Columns.Count).End(xlToLeft).Column
    If desWS.Range("D2") <> "" Then
        desWS.Range("D2:D" & LastRow2).Resize(, lCol2 - 3).ClearContents
    End If
    For x = 5 To lCol Step 3
        desWS.Cells(2, y).Resize(LastRow - 2).Value = srcWS.Cells(3, x).Resize(LastRow - 2).Value
        y = y + 1
    Next x
    Application.ScreenUpdating = True
End Sub

 

[wheatley]

Thanks!

 

[mumps]

You are very welcome.