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
 

Saurabhj

Board Regular
Joined
Jun 6, 2020
Messages
168
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
was hoping to enter vlookup value is VBA made input box, it will continue to fetch the marks until there are no longer ID.
I didn't get. What's the difference in Source and Destination sheet ? It looks same.
 

Some videos you may like

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.

rzml

New Member
Joined
Dec 24, 2020
Messages
26
Office Version
  1. 2016
Platform
  1. Windows
I didn't get. What's the difference in Source and Destination sheet ? It looks same.
there is no difference but this is an example usually the source student ID is shuffled, therefore I was searching for code to get the marks from the source to destination ( the destination order ).
 

Saurabhj

Board Regular
Joined
Jun 6, 2020
Messages
168
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
Hi rzml,

See attached image. I was thinking that you need marks of a student entered in a cell in destination Sheet.

I Used below macro in module which will be execute when user click on the button.

VBA Code:
Option Explicit

Sub showMarks()
    Dim lastRow As Integer, idfound As String, rowno As Integer
    idfound = "No"
    lastRow = Worksheets("Source").Cells(Rows.Count, 1).End(xlUp).Row
    
    Sheets("destination").Range("A5:K5").ClearContents
    If Sheets("destination").Range("B1") = vbNullString Then
        MsgBox "Student ID is blank.", vbInformation
        Exit Sub
    End If
    
    For rowno = 2 To lastRow
        If Sheets("destination").Range("B1") = Sheets("source").Range("A" & rowno) Then
            idfound = "yes"
            Sheets("source").Rows(rowno).Copy Sheets("destination").Range("A5")
            Exit Sub
        End If
    Next
    
    If idfound = "No" Then
        MsgBox "ID not found", vbInformation
    End If
End Sub
 

Attachments

  • studentMarks.PNG
    studentMarks.PNG
    12.7 KB · Views: 2

maabadi

Well-known Member
Joined
Oct 22, 2012
Messages
1,089
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
Try this. This macro also search for Section and return its result:
VBA Code:
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("Sheet2").Cells(1, 1), Sheets("Sheet2").Cells(1, Lc2))
For j = 2 To Lc2
Set Cr1 = Sheets("Sheet2").Cells(1, j)
b = Application.WorksheetFunction.Match(Cr1, MyRange3, 0)
Debug.Print b
For i = 2 To Lr2
Cells(i, j).Value = Application.WorksheetFunction.VLookup(Range("A" & i), MyRange1, b, False)
Next i
Next j

End Sub
 

rzml

New Member
Joined
Dec 24, 2020
Messages
26
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

Hi rzml,

See attached image. I was thinking that you need marks of a student entered in a cell in destination Sheet.

I Used below macro in module which will be execute when user click on the button.

VBA Code:
Option Explicit

Sub showMarks()
    Dim lastRow As Integer, idfound As String, rowno As Integer
    idfound = "No"
    lastRow = Worksheets("Source").Cells(Rows.Count, 1).End(xlUp).Row
   
    Sheets("destination").Range("A5:K5").ClearContents
    If Sheets("destination").Range("B1") = vbNullString Then
        MsgBox "Student ID is blank.", vbInformation
        Exit Sub
    End If
   
    For rowno = 2 To lastRow
        If Sheets("destination").Range("B1") = Sheets("source").Range("A" & rowno) Then
            idfound = "yes"
            Sheets("source").Rows(rowno).Copy Sheets("destination").Range("A5")
            Exit Sub
        End If
    Next
   
    If idfound = "No" Then
        MsgBox "ID not found", vbInformation
    End If
End Sub
thank you so much for your reply. but I need the code to go into a loop to fill the destination table since I have to do more work on the generated destination table (such as statistics). p.s the destination table is usually a data dump.
 

maabadi

Well-known Member
Joined
Oct 22, 2012
Messages
1,089
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
Try this Modified Version:
VBA Code:
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))
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
Cells(i, j).Value = Application.WorksheetFunction.VLookup(Range("A" & i), MyRange1, b, False)
Next i
Next j
ErrorHandler:
MsgBox "ID Not Found"
Cr1.Select
Exit Sub

End Sub
 

rzml

New Member
Joined
Dec 24, 2020
Messages
26
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

Try this Modified Version:
VBA Code:
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))
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
Cells(i, j).Value = Application.WorksheetFunction.VLookup(Range("A" & i), MyRange1, b, False)
Next i
Next j
ErrorHandler:
MsgBox "ID Not Found"
Cr1.Select
Exit Sub

End Sub
1609315417756.png

its giving me id not found
 

maabadi

Well-known Member
Joined
Oct 22, 2012
Messages
1,089
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
Sorry My fault. Do it works correctly? If yes, I change error Handler Section.
 

maabadi

Well-known Member
Joined
Oct 22, 2012
Messages
1,089
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
If shows error go to Excel sheet and see what cell value is red color and check it correct and have it at your source data.
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))
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
Exit Sub
ErrorHandler2:
MsgBox "ID Not Found"
Cells(i, 1).Select
Cells(i, 1).Font.ColorIndex = 3
Exit Sub
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,119,021
Messages
5,575,614
Members
412,679
Latest member
TSpan
Top