Setting up a grading matrix, vlookup doesn't help

Hi there,
I 'foolishly' offered to help a local school set up some standard forms etc! All have gone OK except for this one which is driving me nuts. I have tried vlookups, if functions etc, just can't get it working... I suspect it needs some VBA...

I have attached what I am trying to achieve. Input tab has the data, basically a set of grades for students, one grade at age 8, the other grade at age 11. I am trying to present this in a matrix, see Output tab. I want to automatically place the student name(s) in the cell that corresponds to their two grades. I have manually done the first 6 names.
teacher grading tool.xlsx

Your assistance would be much appreciated.
Thanks

Hi,

I can only see three manually-entered results, though I think I get the picture.

However, you don't mention what the results should be if two or more students have identical grades. My first thought was comma-separated in the same cell, though, above a certain number, this could become quite ungainly, not to mention the fact that it would then make a formula-based solution problematic and therefore require some VBA.

Please clarify.

Regards

Or another approach:

Sub foo()
Dim lSourceRow As Long, lPasteRow As Long, lPasteCol As Long
Dim stPupil As String, stOutput As String
For lSourceRow = 4 To 25
    stPupil = Sheets("Input").Cells(lSourceRow, 2).Value
    lPasteRow = 8 + WorksheetFunction.Match(Sheets("Input").Cells(lSourceRow, 4).Value, Worksheets("Output").Range("C9:C19"), 0)
    lPasteCol = 3 + WorksheetFunction.Match(Sheets("Input").Cells(lSourceRow, 3).Value, Worksheets("Output").Range("D20:L20"), 0)
    If Worksheets("Output").Cells(lPasteRow, lPasteCol).Value = "" Then
        stOutput = stPupil
    Else
        stOutput = Worksheets("Output").Cells(lPasteRow, lPasteCol).Value & ", " & stPupil
    End If
   Worksheets("Output").Cells(lPasteRow, lPasteCol).Value = stOutput
Next lSourceRow
End Sub

I was going to have a go at this but the competition was just too quick.

For my own benefit, I put the code into the workbook so I could see how it worked. The result is attached.

One question for OllyXLS: your routine seems to double up in some instances, although not all. Why is that?

Regards, TMS

Originally Posted by TMShucks

One question for OllyXLS: your routine seems to double up in some instances, although not all. Why is that?

Ah, looks like you didn't delete the example results which were pre-filled in the output sheet. Apologies - I should have set my routine to clear the output range first.

@Rossg59b: Thanks for the rep.

@OllyXLS: that's exactly right. I copied the sheet and renamed it so that a) I had the structure and b) I could compare the results.

Regards, TMS

Final option (maybe) using arrays:

Sub TMS()

Dim shIn As Worksheet: Set shIn = Sheets("Input")
Dim shOut As Worksheet: Set shOut = Sheets("TMS")
Dim rIn As Range, rOut As Range
Dim vIn, vInR, vInC, vOut
Dim i As Long
Dim sPupil As String, vGat8, vGat11
Dim lRIndex As Long, lCIndex As Long
Dim awf As WorksheetFunction: Set awf = WorksheetFunction

Application.ScreenUpdating = True

' store the data from the input sheet
With shIn
    vIn = .Range(.Range("B4"), _
                 .Range("B4").End(xlDown)) _
          .Resize(, 3)
End With

' set the range(s) from the output sheet
With shOut
    ' use for lookup
    Set rIn = .Range(.Range("C9"), _
                     .Range("C9").End(xlDown))
    ' where the output is going
    Set rOut = rIn.Offset(0, 1).Resize(, rIn.Rows.Count)
End With

vInR = awf.Transpose(rIn)   ' row lookup, Grade at 11
vInC = awf.Transpose(rIn)   ' just to get the size
' column lookup, Grade at 8 (reverse row values)
For i = LBound(vInR) To UBound(vInR)
    vInC(i) = vInR(UBound(vInR) - i + 1)
Next i

' prepare the output matrix
ReDim vOut(LBound(vInR) To UBound(vInR), _
           LBound(vInC) To UBound(vInC))

' loop through the input data and store in output matrix
For i = LBound(vIn, 1) To UBound(vIn, 1)
    sPupil = vIn(i, 1): vGat8 = vIn(i, 2): vGat11 = vIn(i, 3)
    lRIndex = awf.Match(vGat11, vInR, 0)
    lCIndex = awf.Match(vGat8, vInC, 0)
    If vOut(lRIndex, lCIndex) = "" Then
        vOut(lRIndex, lCIndex) = sPupil
    Else
        vOut(lRIndex, lCIndex) = _
            vOut(lRIndex, lCIndex) & ", " & _
            sPupil
    End If
Next 'i

' clear/format the output range
With rOut
    .ClearContents
    .HorizontalAlignment = xlGeneral
    .VerticalAlignment = xlTop
    .WrapText = True
End With

' move output matrix to worksheet
rOut = vOut

Application.ScreenUpdating = True

End Sub

Regards, TMS