Random numbers appearing, calculations showing as zero

[ophelia]

Code:
--------------------
Function CustomAverage(pRange As Range, pThreshold As Long) As Long

Dim LFirstRow, LLastRow As Integer
Dim LFirstCol, LLastCol As Integer

Dim LCurrentRow As Integer
Dim LCurrentCol As Integer

Dim LTotal As Double
Dim LCount As Integer

On Error GoTo Err_Execute

'Determine first and last row to average
LFirstRow = pRange.Row
LLastRow = LFirstRow + pRange.Rows.Count - 1

'Determine first and last column to average
LFirstCol = pRange.Column
LLastCol = LFirstCol + pRange.Columns.Count - 1

'Initialize variables
LTotal = 0
LCount = 0

'Move through each cell in the range and include in the average
' calculation if the value >= pThreshold
For LCurrentCol = LFirstCol To LLastCol
For LCurrentRow = LFirstRow To LLastRow
If Cells(LCurrentRow, LCurrentCol) >= pThreshold Then
LTotal = LTotal + Cells(LCurrentRow, LCurrentCol)
LCount = LCount + 1
End If
Next
Next

'Return the average

' check that LCount is not zero and return 0 average if so, this happens in the case
' that all values were below the threshold or null.. which would cause trouble (error)
If LCount = 0 Then
CustomAverage = 0
Else
CustomAverage = LTotal / LCount
End If

On Error GoTo 0

Exit Function

Err_Execute:
CustomAverage = 0
'MsgBox "An error occurred while calculating the Custom Average."

End Function

--------------------


Hi, I was wondering if I could have some help, okay, well the code
above works perfectly, does exactly what I want it to, but it's a bit
buggy, well the spreadsheet is anyway, basically, random numbers will
appear in cells which don't have numbers in them(i.e the custom average
of 4 blank cells will return a "60" as a value, and zeros will appear
where there should be calculations using the custom average function,
i,e the custom average of 60,40, 10 will be zero)
If you click into the cell and press enter, or if you auto fill the
formula (drag it over) from neighbour cells then the calculation will
refresh and will be correct/the zeros will appear/dissapear. obviously
this is a big spreadsheet, and I can't click in every single cell by
hand, is there a way to auto refresh the entire spreadsheet, or
possibly, is there a way to stop it from happening?
If anyone has any ideas then it would be much appreciated
Thanks!

 

[K Dales]

Put the line Application.Volatile in your code.
Excel does not automatically recognize when user functions need to be
automatically recalculated; Application.Volatile is the way to tell it to
recalc your formula for you.

 

[Charles Williams]

Hi Ophelia,

try something like this:

Function CustomAverage(pRange As Range, pThreshold As Long) As Variant

Dim LTotal As Double
Dim LCount As long

dim k as long
dim j as long
dim vRange as variant

On Error GoTo Err_Execute

'
' get range into variant containing array
'

vRange=pRange

'Initialize variables
LTotal = 0
LCount = 0

'Move through each cell in the range and include in the average
' calculation if the value >= pThreshold

For j=1 to ubound(vrange,1)
for k=1 to ubound(vrange,2)
if not isempty(vrange(j,k)) then
If vrange(j,k) >= pThreshold Then
LTotal = LTotal + vrange(j,k)
LCount = LCount + 1
End If
endif
Next k
Next j

'Return the average

' check that LCount is not zero and return 0 average if so, this happens
in the case
' that all values were below the threshold or null.. which would cause
trouble (error)

If LCount = 0 Then
CustomAverage = 0
Else
CustomAverage = LTotal / LCount
End If

On Error GoTo 0

Exit Function

Err_Execute:
CustomAverage = 0
'MsgBox "An error occurred while calculating the Custom Average."

End Function


regards
Charles
______________________
Decision Models
FastExcel 2.2 Beta now available
www.DecisionModels.com

 

[ophelia]

Hi,
Thanks both of you for your replies,I'm very grateful! Although I'm
having some issues with both of the bits of code at the moment.

Whenever I put the Volatile application code in, I get 1.circular
formula errors that I was not previously getting and 2.It will update
the values on the active sheet, and not any others, as soon as I click
on another sheet and go back the values are fudged and need to be
refreshed again.
As I have cascading values and linked sheets, this wont really work for
me
Is there anything else I can do?

Charles Williams:
I've tried your code out and it works perfectly, thank you so much! The
only issue I'm having is that it doesn't like blank cells, like values
of 10,10,10 and blank will return as "0" rather than 10, if I replace
the blank with a "0" the code then works fine, I kind of need to make
this idiot proof, is there anything I can do to take into account the
blanks?

Thank you so much!

 

[Charles Williams]

Hi Ophelia,

Not sure what you wanted to do with blanks, but this version excludes
anything that isnt numeric and returns #N/A if there is an error.


Option Explicit
Function CustomAverage(pRange As Range, pThreshold As Long) As Variant

Dim LTotal As Double
Dim LCount As Long
Dim k As Long
Dim j As Long
Dim vRange As Variant

On Error GoTo Err_Execute
'
' get range into variant containing array
'
vRange = pRange
'Initialize variables
LTotal = 0
LCount = 0
'Move through each cell in the range and include in the average
' calculation if the value >= pThreshold
For j = 1 To UBound(vRange, 1)
For k = 1 To UBound(vRange, 2)
If Not IsEmpty(vRange(j, k)) Then
If IsNumeric(vRange(j, k)) Then
If vRange(j, k) >= pThreshold Then
LTotal = LTotal + vRange(j, k)
LCount = LCount + 1
End If
End If
End If
Next k
Next j

' Return the average
' check that LCount is not zero and return 0 average if so, this happens
' in the case
' that all values were below the threshold or null.. which would cause
' trouble (Error)

If LCount = 0 Then
CustomAverage = 0
Else
CustomAverage = LTotal / LCount
End If
On Error GoTo 0
Exit Function

Err_Execute:
CustomAverage = CVErr(xlErrNA)
End Function


--
Charles
______________________
Decision Models
FastExcel 2.2 Beta now available
www.DecisionModels.com

 

[ophelia]

Thanks so much for all your help, and your hard work
What I was wanting really was for the blanks to be treated as Zeros, is
that possible?



If not, no worries, you've already helped me out a huge amount!

 

[Charles Williams]

add this line after "If Not IsEmpty(vRange(j, k)) Then"

if len(cstr(vRange(j,k)))=0 then vRange(j,k)=0

Note that the function will now ignore empty (unused) cells, but treat cells
containing a blank as zero.

--
Charles
______________________
Decision Models
FastExcel 2.2 Beta now available
www.DecisionModels.com