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

R

rzml

New Member
Joined
Dec 24, 2020
Messages
40
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
 
Sort by date Sort by votes
rzml said:
was hoping to enter vlookup value is VBA made input box, it will continue to fetch the marks until there are no longer ID.
Click to expand...
I didn't get. What's the difference in Source and Destination sheet ? It looks same.
 
Upvote 0

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.
Saurabhj said:
I didn't get. What's the difference in Source and Destination sheet ? It looks same.
Click to expand...
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 ).
 
Upvote 0
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: 6
Upvote 0
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
 
Upvote 0
Saurabhj said:
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
Click to expand...
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.
 
Upvote 0
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
 
Upvote 0
maabadi said:
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
Click to expand...
1609315417756.png

its giving me id not found
 
Upvote 0
Sorry My fault. Do it works correctly? If yes, I change error Handler Section.
 
Upvote 0
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
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Question
Pivot Table report
Replies
0
Views
129
cccbzg
C
Z
  • Solved
Excel VBA: Using OR with <>
Replies
3
Views
94
rlv01
R
A
  • Solved
10 outputs on single sheet
2
Replies
11
Views
541
amkkhan
A
M
  • Question
Hi, Have a problem with Power Automate and decided to use Excel VBA
Replies
3
Views
214
ides315
I
I
  • Question
VBA - Copy Sheet from a workbook saved as a date - paste to specifically named sheet in another workbook based on the date
Replies
2
Views
196
Insurance Dave
I

Forum statistics

Threads
1,214,520
Messages
6,120,017
Members
448,937
Latest member
BeerMan23

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top