Custom function returning #VALUE! Error in Excel 2016

Question

I wrote some VBA code to search through my Excel Sheet.

When giving out the expected value in the debug console it works but calling it in a cell returns the #VALUE! error.

Here's my code

Option Explicit

Public Function calcGrade() As Double

    Dim graded As New Collection

    Dim credits As Integer

    Dim grade As Double

    Dim cumCredits As Integer

    Dim cumGrade As Double

    Dim finalGrade As Double

    cumCredits = 0

    cumGrade = 0

    Dim Match As Range

    Dim firstMatch As String

    With Application.ActiveSheet.UsedRange

        Set Match = .Find(what:=True, LookIn:=xlValues) 'Set match contition and search

        If Not Match Is Nothing Then                    'If match is found

            firstMatch = Match.Address                  'Save first found match

            Do

                credits = Match.Offset(1, 0).Value

                grade = Match.Offset(2, 0).Value

                If grade <> 0 Then

                    graded.Add (credits * grade)

                    cumCredits = cumCredits + credits

                End If

                Set Match = .FindNext(Match)            'Find next match

            Loop While Not Match Is Nothing And Match.Address <> firstMatch

                                                        'Loop until first match is found again

        End If

    End With

    Dim val As Variant

    For Each val In graded

        cumGrade = cumGrade + val

    Next val

    finalGrade = cumGrade / cumCredits

    Debug.Print finalGrade

    calcGrade = finalGrade

End Function

What am I doing wrong? Thanks!

Moved from:Office / Excel / Other/unknown / Office 2016

Answer 1

The function works correctly when you call it from VBA, but when you use it as a worksheet function, FindNext immediately returns Nothing although there are further matches.

The following version works in a worksheet formula, but you have to specify the range:

Public Function calcGrade(rng As Range) As Double

    Dim graded As New Collection

    Dim credits As Integer

    Dim grade As Double

    Dim cumCredits As Integer

    Dim cumGrade As Double

    Dim finalGrade As Double

    Dim Match As Range

    For Each Match In rng

        If Match.Value = True Then

            credits = Match.Offset(1, 0).Value

            grade = Match.Offset(2, 0).Value

            If grade <> 0 Then

                graded.Add (credits * grade)

                cumCredits = cumCredits + credits

            End If

        End If

    Next Match

    Dim val As Variant

    For Each val In graded

        cumGrade = cumGrade + val

    Next val

    finalGrade = cumGrade / cumCredits

    'Debug.Print finalGrade

    calcGrade = finalGrade

End Function

Example of use:

=calcGrade(B2:K10)

Answer 2

This is great! Thanks for the help!