Marks Sheet

[josephrozario]

<small style="box-sizing: border-box; -webkit-font-smoothing: antialiased; font-size: 11.04px; text-transform: uppercase; display: block; color: rgb(105, 109, 111); font-family: "Helvetica Neue", roboto, Arial, sans-serif; background-color: rgb(238, 242, 244); outline: none !important; -webkit-tap-highlight-color: transparent !important;">
</small>I Have put data validation of subjects in a cell, I need Highest Marks and Student Name to be populated when I select a particular subject.(and if more than one student have the same highest marks, than all the student names) The Subjects are in columns and Student Names are in rows.

	Class 10-D Final Exam Report Card
Roll No.	Student Name	English	Hindi	Maths	Science	Social Science	TOTAL	AGGREGATE%
1	Ajay Kumar	83	76	90	91	89	429	86
2	Mohan Singh	89	76	88	85	80	418	84
3	Deepak Bansal	81	70	79	70	77	377	75
4	Samir Sharma	90	78	93	91	90	442	88
5	Mohit Pandey	88	71	85	81	73	398	80
6	Pankaj Mathur	78	72	87	88	77	402	80
7	Ashish Pandey	94	91	98	97	90	470	94
8	Joseph Rozario	93	90	99	97	88	467	93
	Subject	Highest Marks	Student Name
	English

<tbody>
</tbody>

 

[mumps]

This macro assumes that your data validation list is in cell B12 and Subject,Highest Marks and Student Name are in B11, C11 and D11 respectively. Copy and paste this macro into the worksheet code module. Do the following: right click the tab for your sheet and click 'View Code'. Paste the macro into the empty code window that opens up. Close the code window to return to your sheet. Make a selection in B12.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("B12")) Is Nothing Then Exit Sub
    Dim bottomA As Long
    bottomA = Range("A" & Rows.Count).End(xlUp).Row
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim maxVal As Range
    Dim sAddr As String
    Range("C12:D" & LastRow).ClearContents
    Set foundSub = Rows(1).Find(Target)
    If Not foundSub Is Nothing Then
        Target.Offset(0, 1) = WorksheetFunction.Max(Range(Cells(2, foundSub.Column), Cells(bottomA, foundSub.Column)))
        Set maxVal = Range(Cells(2, foundSub.Column), Cells(bottomA, foundSub.Column)).Find(Target.Offset(0, 1))
        If Not maxVal Is Nothing Then
            sAddr = maxVal.Address
            Do
                Cells(Rows.Count, "D").End(xlUp).Offset(1, 0) = Cells(maxVal.Row, 2)
                Set maxVal = Range(Cells(2, foundSub.Column), Cells(bottomA, foundSub.Column)).FindNext(maxVal)
            Loop While maxVal.Address <> sAddr
            sAddr = ""
        End If
    End If
End Sub