anilsharaf
New Member
 Joined
 Apr 8, 2014
 Messages
 31
 Office Version

 2007
 Platform

 Windows
This is UDF
Function PassOrFailAnvl(Allsub As Range, _
Optional Practicle As Range) As String
'First make result with theory marks and
'After making result add the Project marks
'only to calculate percentage.
'if U want to see this run line by line like a SubProcedure
'Put an apostrophy before select case and run on sheet
Dim A, B, C, x As Variant
A = Application.WorksheetFunction.CountIf(Allsub, "abs")
B = Application.WorksheetFunction.CountIf(Allsub, "<25")
'C = Application.WorksheetFunction.CountIf(Practicle, "<8")
x = A + B + C
Select Case x
Case Is < 1
PassOrFailAnvl = "PASS"
Case Is < 3
PassOrFailAnvl = "SUPPL"
Case Is > 2
PassOrFailAnvl = "FAIL"
End Select
End Function
And this is Procedure
Sub PassOrFailSub()
Dim mt(6), mp(6) 'MarksTheory,MarksPracticle
Dim i, j, k, l, m, n As Integer
Set Tc = Application.InputBox(Prompt:="Select Total Cell", Type:=8)
Colm = Tc.Column
lastrow = Cells(65536, Colm).End(xlUp).Row
Tc.Select
'mt = MarksOfTheory
Do Until Selection = ""
i = 1
For j = 18 To 1 Step 3
'nt = ActiveCell.Offset(0, j)
mt(i) = ActiveCell.Offset(0, j) 'MarksTreoryArray
If mt(i) = "abs" Then
mt(i) = 0: End If
i = i + 1: If i = 7 Then Exit For
Next j
'mp= MarksOfPracticle
k = 1
For l = 17 To 1 Step 3
'nt = ActiveCell.Offset(0, j)
mp(k) = ActiveCell.Offset(0, l) 'MarksPracticleArray
If mp(k) = "abs" Then
mp(k) = 0: End If
k = k + 1: If k = 7 Then Exit For
Next l
u = LBound(mt)
'Check if MarksTheory is smaller than PassingMarks(25)
y = 0
For m = LBound(mt) To UBound(mt)
If mt(m) < 25 Then
y = y + 1
End If
Next m
'Check if MarksPracticle is smaller than PassingMarks(8)
Z = 0
For n = LBound(mp) To UBound(mp)
If mp < 8 Then
Z = Z + 1
End If
Next n
x = y + Z
Select Case x
Case Is < 1
PassFail = "PASS"
Case Is < 3
PassFail = "SUPPL"
Case Is > 2
PassFail = "FAIL"
End Select
ActiveCell.Offset(0, 1) = PassFail
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Function PassOrFailAnvl(Allsub As Range, _
Optional Practicle As Range) As String
'First make result with theory marks and
'After making result add the Project marks
'only to calculate percentage.
'if U want to see this run line by line like a SubProcedure
'Put an apostrophy before select case and run on sheet
Dim A, B, C, x As Variant
A = Application.WorksheetFunction.CountIf(Allsub, "abs")
B = Application.WorksheetFunction.CountIf(Allsub, "<25")
'C = Application.WorksheetFunction.CountIf(Practicle, "<8")
x = A + B + C
Select Case x
Case Is < 1
PassOrFailAnvl = "PASS"
Case Is < 3
PassOrFailAnvl = "SUPPL"
Case Is > 2
PassOrFailAnvl = "FAIL"
End Select
End Function
And this is Procedure
Sub PassOrFailSub()
Dim mt(6), mp(6) 'MarksTheory,MarksPracticle
Dim i, j, k, l, m, n As Integer
Set Tc = Application.InputBox(Prompt:="Select Total Cell", Type:=8)
Colm = Tc.Column
lastrow = Cells(65536, Colm).End(xlUp).Row
Tc.Select
'mt = MarksOfTheory
Do Until Selection = ""
i = 1
For j = 18 To 1 Step 3
'nt = ActiveCell.Offset(0, j)
mt(i) = ActiveCell.Offset(0, j) 'MarksTreoryArray
If mt(i) = "abs" Then
mt(i) = 0: End If
i = i + 1: If i = 7 Then Exit For
Next j
'mp= MarksOfPracticle
k = 1
For l = 17 To 1 Step 3
'nt = ActiveCell.Offset(0, j)
mp(k) = ActiveCell.Offset(0, l) 'MarksPracticleArray
If mp(k) = "abs" Then
mp(k) = 0: End If
k = k + 1: If k = 7 Then Exit For
Next l
u = LBound(mt)
'Check if MarksTheory is smaller than PassingMarks(25)
y = 0
For m = LBound(mt) To UBound(mt)
If mt(m) < 25 Then
y = y + 1
End If
Next m
'Check if MarksPracticle is smaller than PassingMarks(8)
Z = 0
For n = LBound(mp) To UBound(mp)
If mp < 8 Then
Z = Z + 1
End If
Next n
x = y + Z
Select Case x
Case Is < 1
PassFail = "PASS"
Case Is < 3
PassFail = "SUPPL"
Case Is > 2
PassFail = "FAIL"
End Select
ActiveCell.Offset(0, 1) = PassFail
ActiveCell.Offset(1, 0).Select
Loop
End Sub