Reputation: 836
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
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