code to get students marks from source sheet to destination sheet.

[rzml]

hi,
I am looking for a VBA code that can get student marks using his ID and evaluation type (as headers) from source sheet to destination sheet. I am hoping that it would be vlookup with an input box (since the evaluation type and student will change).

Thanks

 

[maabadi]

This is Last code that Bold (red Color) if Variable or ID not found at source Sheet.

Option Explicit

Sub OutPut()
Dim i As Long, b As Long, j As Long
Dim Lr1 As Long, Lr2 As Long, Lc1 As Long, Lc2 As Long
Dim MyRange1 As Range, MyRange2 As Range, MyRange3 As Range, Cr1 As Range

Lr1 = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
Lr2 = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
Lc1 = Sheets("Sheet1").Cells(1, Columns.Count).End(xlToLeft).Column
Lc2 = Sheets("Sheet2").Cells(1, Columns.Count).End(xlToLeft).Column
Set MyRange1 = Range(Sheets("Sheet1").Cells(1, 1), Sheets("Sheet1").Cells(Lr1, Lc1))
Set MyRange2 = Range(Sheets("Sheet2").Cells(2, 2), Sheets("Sheet2").Cells(Lr2, Lc2))
Set MyRange3 = Range(Sheets("Sheet1").Cells(1, 1), Sheets("Sheet1").Cells(1, Lc1))
Range(Sheets("Sheet2").Cells(1, 1), Sheets("Sheet2").Cells(Lr2, Lc2)).Font.ColorIndex = 1
For j = 2 To Lc2
Set Cr1 = Sheets("Sheet2").Cells(1, j)
On Error GoTo ErrorHandler
b = Application.WorksheetFunction.Match(Cr1, MyRange3, 0)
Debug.Print b
For i = 2 To Lr2
On Error GoTo ErrorHandler2
Cells(i, j).Value = Application.WorksheetFunction.VLookup(Range("A" & i), MyRange1, b, False)
Next i
Next j
Exit Sub
ErrorHandler:
MsgBox "Variable Not Found"
Cr1.Select
Cr1.Font.ColorIndex = 3
Resume Next
Exit Sub
ErrorHandler2:
MsgBox "ID Not Found"
Cells(i, 1).Select
Cells(i, 1).Font.ColorIndex = 3
Resume Next
Exit Sub
End Sub

 

[rzml]

This is Last code that Bold (red Color) if Variable or ID not found at source Sheet.

Option Explicit

Sub OutPut()
Dim i As Long, b As Long, j As Long
Dim Lr1 As Long, Lr2 As Long, Lc1 As Long, Lc2 As Long
Dim MyRange1 As Range, MyRange2 As Range, MyRange3 As Range, Cr1 As Range

Lr1 = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
Lr2 = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
Lc1 = Sheets("Sheet1").Cells(1, Columns.Count).End(xlToLeft).Column
Lc2 = Sheets("Sheet2").Cells(1, Columns.Count).End(xlToLeft).Column
Set MyRange1 = Range(Sheets("Sheet1").Cells(1, 1), Sheets("Sheet1").Cells(Lr1, Lc1))
Set MyRange2 = Range(Sheets("Sheet2").Cells(2, 2), Sheets("Sheet2").Cells(Lr2, Lc2))
Set MyRange3 = Range(Sheets("Sheet1").Cells(1, 1), Sheets("Sheet1").Cells(1, Lc1))
Range(Sheets("Sheet2").Cells(1, 1), Sheets("Sheet2").Cells(Lr2, Lc2)).Font.ColorIndex = 1
For j = 2 To Lc2
Set Cr1 = Sheets("Sheet2").Cells(1, j)
On Error GoTo ErrorHandler
b = Application.WorksheetFunction.Match(Cr1, MyRange3, 0)
Debug.Print b
For i = 2 To Lr2
On Error GoTo ErrorHandler2
Cells(i, j).Value = Application.WorksheetFunction.VLookup(Range("A" & i), MyRange1, b, False)
Next i
Next j
Exit Sub
ErrorHandler:
MsgBox "Variable Not Found"
Cr1.Select
Cr1.Font.ColorIndex = 3
Resume Next
Exit Sub
ErrorHandler2:
MsgBox "ID Not Found"
Cells(i, 1).Select
Cells(i, 1).Font.ColorIndex = 3
Resume Next
Exit Sub
End Sub

thank you, thank you. worked PERFECT!!!!

 

[maabadi]

You 're Welcome & Thanks for Feedback.