Help with Excel sheets

[Alsok2]

Hello. I need help with developing a formula for data extraction:
Spreadsheet #1 contains student data which my IT dept. imports into a student
intake database. Prior to import, however, I would like to extract test
score information from a second spreadsheet.

The common identifiers between the two spreadsheets are "Last Name" and
"First Name" to identify the students. The columns I want to extract and
place at the end of each student's data from sheet #2 to sheet #1 are
"Total", "Written" and "Reading". I know this can be done but I am unsure
because the record totals vary per sheet and I am just nervous because of the
sensitive nature of the material (test scores!)

Any help would be appreciated. Thank you.

 

[Ryan H]

Ok, I had to make a lot of assumptions. I assumed that the last names are in
Col.A and first names are in Col.B for both sheets. Plus I assumed Total was
Col. C, Written was Col. D, and Reading was Col. E. I also assumed you have
a header row so I started the range on row 2. You will have to adjust the
the code to fit your application exactly.

This code will scan down each last name in sheet1 trying to find that last
name in sheet2. It will then try to match the first names. If it finds a
match (last & first name) it will copy over the Total, Written, & Reading
scores. If the first name doesn't match it will search the next matching
last name and then test that first name and so on. If it doesn't find a
match for last and first "exactly" nothing will happen, it will just move on
to the next name.

Hope this helps! If so, let me know, click "YES" below.

Sub TransferTestScores()

Dim lngLastRow1 As Long
Dim lngLastRow2 As Long
Dim rngStudents1 As Range
Dim rngStudents2 As Range
Dim c As Range
Dim strFirstAddress As String
Dim rngFoundName As Range


' range of student last names in sheet1
lngLastRow1 = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
Set rngStudents1 = Sheets("Sheet1").Range("A2:A" & lngLastRow1)

' range of student last names in sheet2
lngLastRow2 = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row
Set rngStudents2 = Sheets("Sheet2").Range("A2:A" & lngLastRow2)

For Each c In rngStudents1

' find student last name in sheet2
Set rngFoundName = rngStudents2.Find(What:=c.Text, _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

' if last name is found
If Not rngFoundName Is Nothing Then

' test if first names match
If c.Offset(, 1).Text = rngFoundName.Offset(, 1).Text Then
With Sheets("Sheet2")
c.Offset(, 2).Value = .Cells(rngFoundName.Row,
"C").Value ' Total
c.Offset(, 3).Value = .Cells(rngFoundName.Row,
"D").Value ' Written
c.Offset(, 4).Value = .Cells(rngFoundName.Row,
"E").Value ' Reading
End With
Else
strFirstAddress = c.Address
Do
Set c = rngStudents2.FindNext(c.Text)
Loop While Not c Is Nothing And c.Address <> strFirstAddress
End If
End If
Next c

End Sub

 

[Alsok2]

Ryan -- you are so awesome! Even though I have not yet run this, I can tell
that you put a lot of effort into helping me with this. My brain hurts but I
am very appreciative. I should have been more thorough and I will tell you
now that on sheet #1, Last Names are in column C and First Names are in
column D; also, sheet #2 scores, located in columns E (writing), F (reading)
and G (T Total) should end up on sheet #1 in columns AA (writing), AB
(reading), and AC (T Total). I'm not sure if I trust myself to search and
replace on your prog to amend for my project, but I can play around tomorrow.
I thank you and will follow up on Fri. Good day to you!

 

[Ryan H]

I adjusted the code for you. Let me knwo if it works for you. Hope this
helps! If so, let me know, click 'YES" below.

Sub TransferTestScores()

Dim lngLastRow1 As Long
Dim lngLastRow2 As Long
Dim rngStudents1 As Range
Dim rngStudents2 As Range
Dim c As Range
Dim strFirstAddress As String
Dim rngFoundName As Range


' range of student last names in sheet1
lngLastRow1 = Sheets("Sheet1").Cells(Rows.Count, "C").End(xlUp).Row
Set rngStudents1 = Sheets("Sheet1").Range("C2:C" & lngLastRow1)

' range of student last names in sheet2
lngLastRow2 = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row
Set rngStudents2 = Sheets("Sheet2").Range("A2:A" & lngLastRow2)

For Each c In rngStudents1

' find student last name in sheet2
Set rngFoundName = rngStudents2.Find(What:=c.Text, _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

' if last name is found
If Not rngFoundName Is Nothing Then

' test if first names match
If c.Offset(, 1).Text = rngFoundName.Offset(, 1).Text Then
With Sheets("Sheet2")
Sheets("Sheet1").Cells(c.Row, "AC").Value =
..Cells(rngFoundName.Row, "G").Value ' Total
Sheets("Sheet1").Cells(c.Row, "AA").Value =
..Cells(rngFoundName.Row, "E").Value ' Written
Sheets("Sheet1").Cells(c.Row, "AB").Value =
..Cells(rngFoundName.Row, "F").Value ' Reading
End With
Else
strFirstAddress = c.Address
Do
Set c = rngStudents2.FindNext(c.Text)
Loop While Not c Is Nothing And c.Address <> strFirstAddress
End If
End If
Next c

End Sub