CODEWITHSUNDEEP
vbaexcel
wahwahwah
wahwahwah

Reputation: 3177

Iterate over collection

I'm attempting to create a custom function to calculate a "mean monthly performance" percentage based on a cell range in Excel. The function needs to ignore cells with a 0 value and the string "NA".

I'm not facing any problems building the collection from the cell range:

Function KROWPERFMEAN(rng As Range)

Dim val As Integer
Dim i As Integer
Dim cell As Range
Dim coll As Collection
Set coll = New Collection
i = 1

For Each cell In rng
    If (cell.Value <> "NA" And cell.Value <> 0) Then
        coll.Add cell.Value
    End If
Next cell

When I try to loop through the collection, my code is breaking, not throwing an error and not returning a result:

Dim perf As Variant
Dim y As Variant

'loop through collection and get perf
For Each y In coll
    perf = perf + (coll(i) - coll(i + 1)) / coll(i)
    'MsgBox (perf) '<-- both of these message boxes fire with exected #s
    'MsgBox (i)
    i = i + 1
Next

MsgBox ("This message box never fires with no errors thrown")

'assigned "1" to test, code is never reached
KROWPERFMEAN = 1


End Function

Is there an issue with how I'm looping over the collection?

I've tried several solutions (changing the y type, declaring the variable in the For Each block) without success.

Upvotes: 0

Views: 84

Answers (1)

Joshua Dannemann
Joshua Dannemann

Reputation: 2080

The problem is here:

perf = perf + (coll(i) - coll(i + 1)) / coll(i)

With coll(i + 1), once you get to the end of the collection, then you are trying to access a member that does not exist. The error it is silently failing with is "Subscript out of range".

Not knowing the details about your calculation, my best guess is you should probably do something like this because there is no second value to use to calculate on the last step.

Function KROWPERFMEAN(rng As Range)

    Dim val As Integer
    Dim i As Integer
    Dim cell As Range
    Dim coll As Collection
    Set coll = New Collection
    i = 1

    For Each cell In rng
        If (cell.Value <> "NA" And cell.Value <> 0) Then
            coll.Add cell.Value
        End If
    Next cell

    Dim perf As Variant
    Dim y As Variant

    'loop through collection and get perf
    For Each y In coll
        If (i + 1 < coll.Count) Then
            perf = perf + (coll(i) - coll(i + 1)) / coll(i)
        End If
        i = i + 1
    Next

    KROWPERFMEAN = perf
End Function

Upvotes: 2

Related Questions