KCSE Grade Analysis by Use of Excel VBA

Thursday, 04 August, 2022

Private Sub SavetoFile_Click()

On Error Resume Next

Call populateReport

End Sub

Sub populateReport()

Dim shData As Worksheet
Dim shSubpos As Worksheet
Dim shSubGrade As Worksheet
Dim subp As Worksheet
Dim shRpt As Worksheet
Dim gradeSys As Worksheet

Dim v As Integer
Dim lrow As Integer
Dim sString As String

Dim spath, sname As String
Dim wf As WorksheetFunction

Set wf = Application.WorksheetFunction
spath = Application.ActiveWorkbook.path

Set shRpt = ThisWorkbook.Sheets("REPORT")
Set shData = ThisWorkbook.Sheets("DATA")
Set gradeSys = ThisWorkbook.Sheets("gradingSystem")
Set subpos = ThisWorkbook.Sheets("SUBJECTPOSITION")
Set subp = ThisWorkbook.Sheets("subpoints")
Set shSubGrade = ThisWorkbook.Sheets("SUBJECT GRADE")
lrow = Application.WorksheetFunction.CountA(shData.Range("A:A"))
For i = 3 To lrow

sname = ""

    shRpt.Range("A7").Value = shData.Range("A" & i).Value
     sname = shRpt.Range("A" & 7).Value

   For v = 28 To 37
        
        shRpt.Range("D" & v).Value = wf.Index(shData.Range("A2" & ":N" & lrow), _
        wf.Match(sname, shData.Range("A2" & ":A" & lrow), 0), _
        wf.Match(shRpt.Range("C" & v).Value, shData.Range("A2:N2"), 0))
        
         
        shRpt.Range("E" & v).Value = wf.Index(shSubGrade.Range("A2" & ":N" & lrow), _
        wf.Match(sname, shSubGrade.Range("A2" & ":A" & lrow), 0), _
        wf.Match(shRpt.Range("C" & v).Value, shSubGrade.Range("A2:N2"), 0))
                
        
        shRpt.Range("G" & v).Value = wf.Index(subpos.Range("A2" & ":N" & lrow), _
        wf.Match(sname, subpos.Range("A2" & ":A" & lrow), 0), _
        wf.Match(shRpt.Range("C" & v).Value, subpos.Range("A2:N2"), 0))
        
        shRpt.Range("G" & 23).Value = wf.Index(subp.Range("A2" & ":S" & lrow), _
        wf.Match(sname, subp.Range("A2" & ":A" & lrow), 0), _
        wf.Match("MARKS", subp.Range("A2:S2"), 0))
        
        
        shRpt.Range("I" & 23).Value = wf.Index(subp.Range("A2" & ":S" & lrow), _
        wf.Match(sname, subp.Range("A2" & ":A" & lrow), 0), _
        wf.Match("CLASSPOS", subp.Range("A2:S2"), 0))
      
        shRpt.Range("D" & 25).Value = wf.Index(subp.Range("A2" & ":S" & lrow), _
        wf.Match(sname, subp.Range("A2" & ":A" & lrow), 0), _
        wf.Match("OVERALLPOS", subp.Range("A2:S2"), 0))
        
        
        shRpt.Range("I" & 25).Value = wf.Index(subp.Range("A2" & ":S" & lrow), _
        wf.Match(sname, subp.Range("A2" & ":A" & lrow), 0), _
        wf.Match("GRADE", subp.Range("A2:S2"), 0))
        shRpt.Range("D" & 23).Value = sname  
    
    Next v
    
     sString = shData.Range("A" & i).Value
      shRpt.Range("A7").Value = sString
        If shRpt.Range("A7").Value = sString Then
            shRpt.Range("reportcard").ExportAsFixedFormat Type:=0, _
            Filename:=spath & "\" & "_" & shRpt.Range("A7").Value & Format(Now(), _
            "yyyymmdd hhmmss"), Quality:=0, _
            Ignoreprintareas:=False, IncludeDocProperties:=True, _
            openafterpublish:=False
            ActiveSheet.PageSetup.BlackAndWhite = False
            ActiveSheet.PrintOut
        End If
       
        If sString = shData.Range("A" & lrow).Value Then
            MsgBox "All reports saved successfully !"
        Exit Sub
        End If
        
    Next i
End Sub

Private Sub showcbo_Click()
UserForm1.Show

End Sub

Add comment