0

Here is my code, it works when I use 1 range but if I use 2 or more it does not work. I dont really know how to fix my code. Any help would be very appreciated

    Function CUSTOMAVERAGE(rng As Range)
Dim cell As Range, suma As Double, sk As Double, i As Double, vidurkis As Double, max As Double, dup As Double, dupp As Double, down As Double, downn As Double, text1 As String

 suma = 0
For Each cell In rng
    suma = suma + cell.Value
    sk = sk + 1
Next cell
vidurkis = suma / sk



max = 0
For Each cell In rng
    If max < cell.Value Then
    max = cell.Value
    End If
Next cell
max = max

min = max
For Each cell In rng
    If min > cell.Value Then
    min = cell.Value
    End If
Next cell
min = min

dupp = 0
dup = 0
sk = 0
For Each cell In rng
    If vidurkis < cell.Value Then
    dupp = dupp + cell.Value
    sk = sk + 1
    End If
Next cell
dup = dupp / sk



downn = 0
down = 0
sk = 0
For Each cell In rng
    If vidurkis > cell.Value Then
    downn = downn + cell.Value
    sk = sk + 1
    End If
Next cell
down = downn / sk




text1 = "V=" & CStr(vidurkis) & " Min=" & CStr(min) & " Max=" & CStr(max) & " Dup=" & CStr(dup) & " Ddown=" & CStr(down)
CUSTOMAVERAGE = text1
End Function

Any example would be great too.

Community
  • 1
  • 1
  • 1
    Please clarify what "doesn't work" means, and how you are calling this function? There seems like a lot of unnecessary looping here. – Rory Jun 25 '15 at 13:06
  • I'm not sure I follow either - but if you want to expand your current range to another - you could do something like: rng = Union(Range("A1:A100"), Range("C1:C100")) Also as @Rory very rightly says - it does look like you have way too many loops for efficient running – Trum Jun 25 '15 at 13:07
  • what I mean is when I use this fuction i exel =CUSTOMAVERAGE(A1:A5;C7:C11) it does not work I get errro #VALUE! when I use the fuction like =CUSTOMAVERAGE(A1:A5)(with one range) it works just fine – john snow Jun 25 '15 at 14:50
  • 2
    You need to define your function to take multiple parameters. You can either use `Optional` parameters or a `Parameter Array`. [Related question with both options presented](http://stackoverflow.com/questions/2265349/how-can-i-use-an-optional-array-argument-in-a-vba-procedure). As an aside, there is probably a better way to do what you are trying, but this will at least let you do what you are trying. – Byron Wall Jun 25 '15 at 15:13

1 Answers1

0

Try something like this:

Option Explicit

Function CUSTOMAVERAGE(ParamArray ranges())
    Dim rng As Range
    Dim part As Variant
    Dim cell As Range
    Dim i As Double
    Dim suma As Double
    Dim sk As Double
    Dim min As Double
    Dim max As Double
    Dim vidurkis As Double
    Dim dup As Double
    Dim sk1 As Double
    Dim ddown As Double
    CUSTOMAVERAGE = CVErr(xlErrNA)
    Set rng = Nothing
    For Each part In ranges
        If TypeName(part) = "Range" Then
            If TypeName(rng) = "Range" Then
                Set rng = Union(rng, part)
            Else
                Set rng = part
            End If
        End If
    Next
    If rng Is Nothing Then Exit Function
    suma = 0
    sk = 0
    min = 1.79769313486231E+308
    max = -1.79769313486231E+308
    For Each cell In rng
        suma = suma + cell.Value
        sk = sk + 1
        If min > cell.Value Then min = cell.Value
        If max < cell.Value Then max = cell.Value
    Next
    vidurkis = suma / sk
    sk = 0
    dup = 0
    sk1 = 0
    ddown = 0
    For Each cell In rng
        If vidurkis < cell.Value Then
            dup = dup + cell.Value
            sk = sk + 1
        ElseIf vidurkis > cell.Value Then
            ddown = ddown + cell.Value
            sk1 = sk1 + 1
        End If
    Next cell
    If sk = 0 Or sk1 = 0 Then Exit Function
    dup = dup / sk
    ddown = ddown / sk1
    CUSTOMAVERAGE = "V=" & CStr(vidurkis) & " Min=" & CStr(min) & " Max=" & CStr(max) & " Dup=" & CStr(dup) & " Ddown=" & CStr(ddown)
End Function
omegastripes
  • 12,351
  • 4
  • 45
  • 96