CODEWITHSUNDEEP
excelvbafunction
Макс Кроман
Макс Кроман

Reputation: 27

Function to calcuute future values =)

guys, need help with my function, just one moment...if "Range" is null (Cell have value "") then ignore it, because i have alredy done it to count i dont know how to change for ignoring such cells. Thank you

Public Function future (ByVal r1 As Range, ByVal r2 As Range, ByVal r3 As Byte) As Variant  

    On Error GoTo errHandler

    If (r1.Columns.Count <> r2.Columns.Count Or r1.Rows.Count <> 1 Or r2.Rows.Count <> 1) Then
        future = "ERROR!"""
        Exit Function
    End If

    Dim denominatorSum As Double
    Dim numeratorSum As Double
    Dim denominator As Double

    Dim length As Integer

    length = r1.Columns.Count

    numeratorSum = 0
    denominatorSum = 0

    For i = 1 To length
        If i = length Then
            denominator = r2.Cells(1, length - i + 1)
        Else
            denominator = r2.Cells(1, length - i + 1) - r2.Cells(1, length - i) * r3
        End If
        numeratorSum = numeratorSum + (r1.Cells(1, i) * denominator)
        denominatorSum = denominatorSum + denominator
    Next i

    If denominatorSum = 0 Then
        future = "ERROR!"
        Exit Function
    End If

    future = numeratorSum / denominatorSum

    Exit Function

errHandler:

    future = "ERROR!"

End Function

Upvotes: 0

Views: 65

Answers (1)

Chris
Chris

Reputation: 943

try this

Public Function future(ByVal r1 As Range, ByVal r2 As Range, ByVal r3 As Byte) As Variant

    On Error GoTo errHandler

    If (r1.Columns.Count <> r2.Columns.Count Or r1.Rows.Count <> 1 Or r2.Rows.Count <> 1) Then
        future = "ERROR!"""
        Exit Function
    End If

    Dim denominatorSum As Double
    Dim numeratorSum As Double
    Dim denominator As Double
    Dim i As Long, j As Long
    Dim length As Integer
    Dim used_r1 As Collection, used_r2 As Collection
    Dim rngCell As Range

    Set used_r1 = New Collection
    Set used_r2 = New Collection


        length = r1.Columns.Count

    'evaluate filled range and write to collection
    For j = 1 To length
        If Not (IsEmpty(r1.Cells(1, j))) And Not (IsEmpty(r2.Cells(1, j))) Then
            used_r1.Add r1.Cells(1, j).Value
            used_r2.Add r2.Cells(1, j).Value
        End If
    Next

    numeratorSum = 0
    denominatorSum = 0

    For i = 1 To used_r1.Count

        Debug.Print used_r1.Item(i)
        Debug.Print used_r2.Item(i)

        If i = used_r2.Count Then
            denominator = used_r2.Item(used_r2.Count - i + 1)
        Else
            denominator = used_r2.Item(used_r2.Count - i + 1) - used_r2.Item(used_r2.Count - i) * r3
        End If

        numeratorSum = numeratorSum + (used_r1.Item(i) * denominator)
        denominatorSum = denominatorSum + denominator

    Next i

    If denominatorSum = 0 Then
        future = "ERROR!"
        Exit Function
    End If

    future = numeratorSum / denominatorSum

    Exit Function

errHandler:

    future = "ERROR!"

End Function

Upvotes: 1

Related Questions