0

I'm pretty new to UDF's and I'm not sure entirely how they function. My function returns correct information so long no new rows are inserted. It's as if headRng gets saved to memory when first used and doesn't get updated even if a new row is inserted. How can I fix this?

Additionally. My function appears to be looping a LOT of times. In my code you'll see a msgbox that appears after 1000 rows. So I know it's looping at least 1000 times. No idea why it's looping though. Forgot I had another workbook open with this same function which was causing the 1000+ loop.

Example of how it might be used: https://i.stack.imgur.com/5ECqa.png

Function StraightLineFunc(headRng As Range, dataRng As Range) As Double
    Application.Volatile True
    Dim arrCntr As Integer
    Dim arr() As Variant
    Dim rowOffset As Integer
    Dim cntr As Integer
    Dim stdvTotal As Double

    stdvTotal = 0
    cntr = 0
    arrCntr = 1

    For Each cell In headRng
        If cell <> "Response" And cell <> "Open-Ended Response" And cell <> "" Then
            If cell.Offset(-1, 0) <> "" And cntr > 0 Then
                stdvTotal = stdvTotal + StdDev(arr)
            End If
            If cell.Offset(-1, 0) <> "" Then
                cntr = cntr + 1
                'new grouping heading
                Erase arr
                ReDim arr(headRng.Columns.Count)
                arrCntr = 1
                arr(arrCntr) = cell(dataRng.Row - 1, 1).Value
                arrCntr = arrCntr + 1
            Else
                arr(arrCntr) = cell(dataRng.Row - 1, 1).Value
                arrCntr = arrCntr + 1
            End If
        End If
    Next cell
    stdvTotal = stdvTotal + StdDev(arr)
    StraightLineFunc = stdvTotal
End Function

Function StdDev(arr)
     Dim i As Integer
     Dim avg As Single, SumSq As Single
     Dim k1 As Long, k2 As Long

     Dim n As Long
     k1 = LBound(arr)
     k2 = UBound(arr)
     n = 0
     avg = Mean(arr)
     For i = k1 To k2
        If arr(i) = 0 Or arr(i) = "" Then
        'do nothing
        Else
           n = n + 1
             SumSq = SumSq + (arr(i) - avg) ^ 2
        End If
     Next i
     StdDev = Sqr(SumSq / (n - 1))
End Function

Function Mean(arr)
     Dim Sum As Single
     Dim i As Integer
     Dim k1 As Long, k2 As Long
     Dim n As Long
     k1 = LBound(arr)
     k2 = UBound(arr)
     Sum = 0
     n = 0
     For i = k1 To k2
        If arr(i) = 0 Or arr(i) = "" Then
        'do nothing
        Else
            n = n + 1
            Sum = Sum + arr(i)
        End If
     Next i
     Mean = Sum / n
End Function
click here
  • 814
  • 2
  • 10
  • 24
  • 1
    You can get rid of the If statement if you don't want the msgbox. Also, are you calling the function from somewhere else in your code or using it as a formula? – Brian May 12 '16 at 14:26
  • You need to show what you're passing in as headRng and dataRng so there is sufficient context. The code loops around headRng so the definition of that range is likely the cause of your issues? – Dave May 12 '16 at 14:26
  • @Dave, just added a picture of how it would look in use. – click here May 12 '16 at 14:29
  • @Brian, I updated my post to make it a bit more clear – click here May 12 '16 at 14:48
  • @Ralph, I already have been including that in my code as you can see above. It doesn't seem to be properly addressing the issue. – click here May 12 '16 at 15:28
  • Looking at your UDF it seems to me (could be that I am mistaken) that it is a somewhat strange remake of the StDev function as your StDev is recursively added and then erased again just to end up with the normal StDev function. So, wouldn't it be easier to just use the following formula in Excel directly: `=STDEV(E3:I3;K3:Q3)` (for row 3 and then copied down)? – Ralph May 12 '16 at 15:57
  • @Ralph, my UDF finds specific groupings. The screenshot above is a simplified example. My functions identifies groupings and calculates the standard deviation of each grouping and then sums them. It'd be more like `=SUM(STDEV(E3:I3),STDEV(K3:Q3))` But that of course requires the user to manually build out the formula identifying each grouping. Which is what I'm trying to automate. – click here May 12 '16 at 16:08
  • It is being updated. But what change to existing results would you expect? There is nothing in the code to suggest that inserting a new row anywhere should alter the results... – MacroMarc May 12 '16 at 19:56

1 Answers1

1

as about headrng first address remembrance it must be a matter of how you're checking subranges, relying on the presence of certain non blank cells over headrng itself. so that if you insert one or more rows between headrng row and the one above it, it would have a different behavior

as about the looping 1000 times it must be because you must have copied a formula that uses it down to row 1000, so that excel calculates all of them even if you're changing only one row

moreover from your data example I think you should change code as follows

Option Explicit

Function StraightLineFunc1(headRng As Range, dataRng As Range) As Double
    Application.Volatile True
    Dim arrCntr As Integer
    Dim arr() As Variant
    Dim rowOffset As Integer
    Dim cntr As Integer
    Dim stdvTotal As Double
    Dim cell As Range

    stdvTotal = 0
    cntr = 0
    arrCntr = 1

    For Each cell In headRng
        If cell <> "Response" And cell <> "Open-Ended Response" And cell <> "" Then
            If cell.Offset(-1, 0) <> "" And cntr > 0 Then
                stdvTotal = stdvTotal + WorksheetFunction.StDev(arr)
            End If
            If cell.Offset(-1, 0) <> "" Then
                cntr = cntr + 1
                'new grouping heading
                Erase arr
                arrCntr = 1
                ReDim Preserve arr(1 To arrCntr)
                arr(arrCntr) = cell(dataRng.Row - 1, 1).Value
            Else
                arrCntr = arrCntr + 1
                ReDim Preserve arr(1 To arrCntr)
                arr(arrCntr) = cell(dataRng.Row - 1, 1).Value
            End If
        End If
    Next cell
    stdvTotal = stdvTotal + WorksheetFunction.StDev(arr)
    StraightLineFunc1 = stdvTotal
End Function

which however could still suffer form the remembrance issue

so I'd also throw in a different "subranges" checking like follows

Function StraightLineFunc2(headRng As Range, dataRng As Range) As Double
    'Application.Volatile True
    Dim stdvTotal As Double
    Dim j1 As Long, j2 As Long

    j1 = 1
    Do Until InStr("Open-Ended Response", headRng(1, j1)) = 0 And headRng(1, j1) <> ""
        j1 = j1 + 1
    Loop
    Set headRng = headRng.Offset(, j1 - 1).Resize(, headRng.Columns.Count - j1 + 1)

    j1 = 1
    Do While j1 < headRng.Columns.Count
        j2 = j1
        Do While headRng(1, j2) <> "Response" And j2 <= headRng.Columns.Count
            j2 = j2 + 1
        Loop
        stdvTotal = stdvTotal + WorksheetFunction.StDev(Range(headRng(1, j1), headRng(1, j2 - 1)).Offset(dataRng.Row - headRng.Row))
        j1 = j2 + 1
    Loop

    StraightLineFunc2 = stdvTotal
End Function
user3598756
  • 28,893
  • 4
  • 18
  • 28