Hi to all!
I have a spreadsheet containing around 30 sheets, one sheet for each class and then one sheet Database and one sheet Remarks.
The Database sheet will contain around 7000 records (The exact value will fluctuate). It contains data about students and their performance in all subjects. There will be one entry for each subject the student does.
The classes sheets need to summarise the data from the Database sheet class wise.
So what I need is:
Extract the roll (O3 in class sheet and column D in Database sheet) for each class and fill the corresponding sheets.
Extract the names of the students class wise and fill corresponding sheets (Range B7:B46 in class sheet and column G in Database sheet). It's not necessary that whole B7:B46 is filled as there may be less than 40 students in a class.
Extract the teacher names (range C6:P6 in class sheet and column C in Database sheet)
Extract the marks, grades and ranks for each student subject wise and fill C7:P46, V7:AI7, AM:AZ, respectively (column H, I, J in Database sheet).
I’ve tried to do that using the following code.
However the FindNext part is causing an infinite loop.
Also, I need to do same for all the class sheets and I don’t really know how to do that.
Any help will be most appreciated.
The spreadsheet:
https://www.dropbox.com/s/7fn4923qe1xdztr/Master.xlsm?dl=0
The code:
I have a spreadsheet containing around 30 sheets, one sheet for each class and then one sheet Database and one sheet Remarks.
The Database sheet will contain around 7000 records (The exact value will fluctuate). It contains data about students and their performance in all subjects. There will be one entry for each subject the student does.
The classes sheets need to summarise the data from the Database sheet class wise.
So what I need is:
Extract the roll (O3 in class sheet and column D in Database sheet) for each class and fill the corresponding sheets.
Extract the names of the students class wise and fill corresponding sheets (Range B7:B46 in class sheet and column G in Database sheet). It's not necessary that whole B7:B46 is filled as there may be less than 40 students in a class.
Extract the teacher names (range C6:P6 in class sheet and column C in Database sheet)
Extract the marks, grades and ranks for each student subject wise and fill C7:P46, V7:AI7, AM:AZ, respectively (column H, I, J in Database sheet).
I’ve tried to do that using the following code.
However the FindNext part is causing an infinite loop.
Also, I need to do same for all the class sheets and I don’t really know how to do that.
Any help will be most appreciated.
The spreadsheet:
https://www.dropbox.com/s/7fn4923qe1xdztr/Master.xlsm?dl=0
The code:
Code:
Sub ExportData()
Dim shtTD As Worksheet
Dim shtDB As Worksheet
Dim Rng As Range
Dim FindClass, Subject, Teacher As String
Dim Roll, StartCell As Integer
Set shtDB = ThisWorkbook.Worksheets("Database")
Set shtTD = ThisWorkbook.Worksheets("1 Integrity")
FindClass = Sheets("1 Integrity").Range("H3").Value
With Sheets("Database").Range("A:A")
Set Rng = .Find(What:=FindClass, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
'Get the roll
Roll = Rng.Offset(0, 3).Value
Sheets("1 Integrity").Range("O3").Value = Roll
Call ReadValues(shtTD, shtDB, Rng, Roll)
Do
Set Rng = .FindNext(After:=Rng.Offset(Roll, 0))
If Not Rng Is Nothing Then
Call ReadValues(shtTD, shtDB, Rng, Roll)
Else
Exit Do
End If
Loop
End If
End With
End Sub
Sub ReadValues(shtTD, shtDB, Rng, Roll)
'Get the Student names
StartCell = Rng.Row
FirstCell = 7
For i = 1 To Roll
shtTD.Cells(FirstCell, "B").Value = shtDB.Cells(StartCell, "G").Value
FirstCell = FirstCell + 1
StartCell = StartCell + 1
Next
'Get Teacher
Subject = Rng.Offset(0, 1).Value
Teacher = Rng.Offset(0, 2).Value
Select Case Subject
Case "English"
Sheets("1 Integrity").Range("C6").Value = Teacher
'Get the Marks, Grades, Ranks
StartCell = Rng.Row
MarksCol = "C"
GradesCol = "V"
RanksCol = "AM"
Call FillValues(StartCell, Roll, MarksCol, GradesCol, RanksCol, shtTD, shtDB)
Case "French"
Sheets("1 Truth").Range("D6").Value = Teacher
'Get the Marks, Grades, Ranks
StartCell = Rng.Row
MarksCol = "D"
GradesCol = "W"
RanksCol = "AN"
Call FillValues(StartCell, Roll, MarksCol, GradesCol, RanksCol, shtTD, shtDB)
Case "Mathematics"
Sheets("1 Integrity").Range("E6").Value = Teacher
'Get the Marks, Grades, Ranks
StartCell = Rng.Row
MarksCol = "E"
GradesCol = "X"
RanksCol = "AO"
Call FillValues(StartCell, Roll, MarksCol, GradesCol, RanksCol, shtTD, shtDB)
Case "Int. Science"
Sheets("1 Integrity").Range("F6").Value = Teacher
'Get the Marks, Grades, Ranks
StartCell = Rng.Row
MarksCol = "F"
GradesCol = "Y"
RanksCol = "AP"
Call FillValues(StartCell, Roll, MarksCol, GradesCol, RanksCol, shtTD, shtDB)
Case "Home Economics"
Sheets("1 Integrity").Range("G6").Value = Teacher
'Get the Marks, Grades, Ranks
StartCell = Rng.Row
MarksCol = "G"
GradesCol = "Z"
RanksCol = "AQ"
Call FillValues(StartCell, Roll, MarksCol, GradesCol, RanksCol, shtTD, shtDB)
Case "Art & Design"
Sheets("1 Integrity").Range("H6").Value = Teacher
'Get the Marks, Grades, Ranks
StartCell = Rng.Row
MarksCol = "H"
GradesCol = "AA"
RanksCol = "AR"
Call FillValues(StartCell, Roll, MarksCol, GradesCol, RanksCol, shtTD, shtDB)
Case "Computer Studies"
Sheets("1 Integrity").Range("I6").Value = Teacher
'Get the Marks, Grades, Ranks
StartCell = Rng.Row
MarksCol = "I"
GradesCol = "AB"
RanksCol = "AS"
Call FillValues(StartCell, Roll, MarksCol, GradesCol, RanksCol, shtTD, shtDB)
Case "Social Studies"
Sheets("1 Integrity").Range("J6").Value = Teacher
'Get the Marks, Grades, Ranks
StartCell = Rng.Row
MarksCol = "J"
GradesCol = "AC"
RanksCol = "AS"
Call FillValues(StartCell, Roll, MarksCol, GradesCol, RanksCol, shtTD, shtDB)
Case "Entrepreneurship"
Sheets("1 Integrity").Range("K6").Value = Teacher
'Get the Marks, Grades, Ranks
StartCell = Rng.Row
MarksCol = "K"
GradesCol = "AD"
RanksCol = "AT"
Call FillValues(StartCell, Roll, MarksCol, GradesCol, RanksCol, shtTD, shtDB)
Case "Hindi"
Sheets("1 Integrity").Range("L6").Value = Teacher
'Get the Marks, Grades, Ranks
StartCell = Rng.Row
MarksCol = "L"
GradesCol = "AE"
RanksCol = "AU"
Call FillValues(StartCell, Roll, MarksCol, GradesCol, RanksCol, shtTD, shtDB)
Case "Tamil"
Sheets("1 Integrity").Range("M6").Value = Teacher
'Get the Marks, Grades, Ranks
StartCell = Rng.Row
MarksCol = "M"
GradesCol = "AF"
RanksCol = "AV"
Call FillValues(StartCell, Roll, MarksCol, GradesCol, RanksCol, shtTD, shtDB)
Case "Telugu"
Sheets("1 Integrity").Range("N6").Value = Teacher
'Get the Marks, Grades, Ranks
StartCell = Rng.Row
MarksCol = "N"
GradesCol = "AG"
RanksCol = "AW"
Call FillValues(StartCell, Roll, MarksCol, GradesCol, RanksCol, shtTD, shtDB)
Case "Urdu"
Sheets("1 Integrity").Range("O6").Value = Teacher
'Get the Marks, Grades, Ranks
StartCell = Rng.Row
MarksCol = "O"
GradesCol = "AH"
RanksCol = "AX"
Call FillValues(StartCell, Roll, MarksCol, GradesCol, RanksCol, shtTD, shtDB)
Case "PE"
Sheets("1 Integrity").Range("P6").Value = Teacher
'Get the Marks, Grades, Ranks
StartCell = Rng.Row
MarksCol = "P"
GradesCol = "AI"
RanksCol = "AY"
Call FillValues(StartCell, Roll, MarksCol, GradesCol, RanksCol, shtTD, shtDB)
End Select
End Sub
Sub FillValues(StartCell, Roll, MarksCol, GradesCol, RanksCol, shtTD, shtDB)
FirstCell = 7
For i = 1 To Roll
shtTD.Cells(FirstCell, MarksCol).Value = shtDB.Cells(StartCell, "H").Value
shtTD.Cells(FirstCell, GradesCol).Value = shtDB.Cells(StartCell, "J").Value
shtTD.Cells(FirstCell, RanksCol).Value = shtDB.Cells(StartCell, "I").Value
FirstCell = FirstCell + 1
StartCell = StartCell + 1
Next
End Sub
Last edited by a moderator:
