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

rzml

New Member
Joined
Dec 24, 2020
Messages
26
Office Version
  1. 2016
Platform
  1. Windows
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).

1609309143812.png
1609309222548.png


Thanks
 

maabadi

Well-known Member
Joined
Oct 22, 2012
Messages
1,089
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
This is Last code that Bold (red Color) if Variable or ID not found at source Sheet.
VBA Code:
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
 
Solution

Some videos you may like

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.

rzml

New Member
Joined
Dec 24, 2020
Messages
26
Office Version
  1. 2016
Platform
  1. Windows
This is Last code that Bold (red Color) if Variable or ID not found at source Sheet.
VBA Code:
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!!!!
 
Last edited:

maabadi

Well-known Member
Joined
Oct 22, 2012
Messages
1,089
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
You 're Welcome & Thanks for Feedback.
 

Watch MrExcel Video

Forum statistics

Threads
1,119,022
Messages
5,575,622
Members
412,679
Latest member
TSpan
Top