click here
click here

Reputation: 836

UDF not updating when rows inserted

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.sstatic.net/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

Upvotes: 0

Views: 83

Answers (1)

user3598756
user3598756

Reputation: 29421

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

Upvotes: 1

Related Questions