Search code examples
excelvbauser-defined-functionsudf

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

Solution

  • 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