VBA GPA Function Trouble!

Stephen_IV

Well-known Member
Joined
Mar 17, 2003
Messages
1,168
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
Currently I am using this formula =AVERAGE(CHOOSE(MATCH(A1:E1,{"A+","A","A","B+","B","B-","C+","C","C-","D+","D","F"},0),4,3.8,3.6,3.4,3.2,3,2.8,2.6,2.4,2.2,2,0)) to calculate the GPA's and it works fine. What I am trying to do is to wite a function for GPA's and I am coming up short. I am still trying to learn VBA can someone please guide me. Thanks in advance Stephen.

Function gpa(r As Range) As String

On Error GoTo Fail

For Each cell In r
Select Case UCase(Trim(r))

Case "A+": gpa = 4#
Case "A": gpa = 3.8
Case "A-": gpa = 3.6
Case "B+": gpa = 3.4
Case "B": gpa = 3.2
Case "B-": gpa = 3#
Case "C+": gpa = 2.8
Case "C": gpa = 2.6
Case "C-": gpa = 2.4
Case "D+": gpa = 2.2
Case "D": gpa = 1#
Case "D-": gpa = 1#
Case "F": gpa = 0
End Select
Next
Fail:
End Function
Book1
ABCDEFG
1AAAAA3.8
2DD+FA+A2.4
Sheet1






Function gpa(r As Range) As String

On Error GoTo Fail

For Each cell In r
Select Case UCase(Trim(r))

Case "A+": gpa = 4#
Case "A": gpa = 3.8
Case "A-": gpa = 3.6
Case "B+": gpa = 3.4
Case "B": gpa = 3.2
Case "B-": gpa = 3#
Case "C+": gpa = 2.8
Case "C": gpa = 2.6
Case "C-": gpa = 2.4
Case "D+": gpa = 2.2
Case "D": gpa = 1#
Case "D-": gpa = 1#
Case "F": gpa = 0
End Select
Next
Fail:
End Function
 

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.
Your function needs to rturn an array:

Code:
Function gpa(r As Range) As Variant
    Dim Cell As Range
    Dim TempArray() As Variant
    Dim x As Long
    ReDim Preserve TempArray(1 To r.Cells.Count)
    x = 1
    On Error GoTo Fail
    For Each Cell In r
        Select Case UCase(Trim(Cell.Value))
            Case "A+": TempArray(x) = 4#
            Case "A": TempArray(x) = 3.8
            Case "A-": TempArray(x) = 3.6
            Case "B+": TempArray(x) = 3.4
            Case "B": TempArray(x) = 3.2
            Case "B-": TempArray(x) = 3#
            Case "C+": TempArray(x) = 2.8
            Case "C": TempArray(x) = 2.6
            Case "C-": TempArray(x) = 2.4
            Case "D+": TempArray(x) = 2.2
            Case "D": TempArray(x) = 1#
            Case "D-": TempArray(x) = 1#
            Case "F": TempArray(x) = 0
        End Select
        x = x + 1
    Next Cell
    gpa = TempArray
Fail:
End Function

Then you can use:

=AVERAGE(gpa(A1:E1))
 
Upvote 0
Andrew thank you so much. I knew it needed to return something just did not know how to get there. Thanks you again your help is greatly appreciated.
 
Upvote 0
Why not do the average in the function?
Code:
Function gpa(r As Range) As String
Dim score As Double
Dim totscore As Double

    For Each c In r
    
        Select Case UCase(Trim(c))
        
            Case "A+"
                score = 4
            Case "A"
                score = 3.8
            Case "A-"
                score = 3.6
            Case "B+"
                score = 3.4
            Case "B"
                score = 3.2
            Case "B-"
                score = 3
            Case "C+"
                score = 2.8
            Case "C"
                score = 2.6
            Case "C-"
                score = 2.4
            Case "D+"
                score = 2.2
            Case "D"
                score = 2
            Case "D-"
                score = 1
            Case "F"
                score = 0
        End Select
        
        totscore = totscore + score
        
    Next
    
    gpa = totscore / r.Count
    
End Function
Note I don't know if it was a typo or not but in the formula D is 2 while in the code 1.
 
Upvote 0
Norie,

Thanks. There was a typo it should have been as you said D is 2. Thank you very much.
 
Upvote 0

Forum statistics

Threads
1,214,641
Messages
6,120,692
Members
448,979
Latest member
DET4492

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