Finding the minimum value in a list but excluding zeros - a variationon an old problem

J

JAC

I have a problem in Excel that I should like to solve. It concerns
finding the minimum of a list of numerical values, excluding zeros.

The stock answer, suggested by Chip Pearson and other experts, is to
create an array formula of the type:

{=MIN(IF(B1:B20>0,B1:B20,FALSE))}, using CTRL + Shift + Return

However, my application requires very many such formulae, so I set
about writing a VBA subroutine to generate the formulae, using code
similar to the fragment below:

With shtHistory
strFormula = "=MIN(IF('" & .Name & "'!R2C" & intCol & ":R" & j & _
"C" & intCol & "<>0,"
strFormula = strFormula & "'" & .Name & "'!R2C" & intCol & ":R" &
_
j & "C" & intCol & ",FALSE))"

Set rngCell = ws.Range(ws.Cells(j, cint_COL_C),
ws.Cells(j,cint_COL_C))
rngCell.FormulaArray = strFormula
End With

where j is the row number (long), intCol is the column number where
the relevant data is listed, rngCell is a Range and shtHistory is the
codename of a worksheet and ws is a worksheet.

Also, I calculate other descriptive statistics like Mean, Maximum,
Median, Variance and Standard Deviation, without resorting to
filtering, since zeros are not significant. All works well, but the
workbook takes a long time to load since Excel must calculate
thousands of formulae.

Because most of the data in the worksheets of interest is historic and
not subject to change, it is easy enough to avoid formulae where there
is no filtering, since in VBA we have access to functions like MAX,
MEDIAN, AVERAGE, VAR and STDEV via Application.WorksheetFunction.

The code fragment below shows how I have managed this:

strRange = "R2C" & intCol & ":R" & j & "C" & intCol
strRange = Application.ConvertFormula(strRange, xlR1C1, xlA1)
strRange = "'" & shtHistory.Name & "'!" & strRange
Set rngRange = Range(strRange)

.Cells(j, cint_COL_D) = objFunc.Max(rngRange) '
Maximum
dblTemp = objFunc.Average(rngRange)
.Cells(j, cint_COL_E) = objFunc.RoundDown(dblTemp, 0) ' Mean
.Cells(j, cint_COL_F) = objFunc.Median(rngRange) ' Median

However, the coding of the filtering for Minimum represents something
of a problem, for which I have managed a solution that I regard to be
unsatisfactory.

I wonder if I could elicit the help of the group in providing a better
solution.

To facilitate matters and help understanding, I have constructed a
simple Excel workbook. On Sheet1 I have placed the following 20 values
in cells B1 to B20.

99, 54, 58, 58, 0, 50, 59, 8, 44, 63, 34, 71, 76, 76, 45, 16, 79, 87,
14, 46

Significantly, the list contains a zero in cell B5, but the non-zero
minimum is 8 (in cell B8). The following array formula placed in cell
B22 displays the correct value.

{=MIN(IF(B1:B20>0,B1:B20,FALSE))}, using CTRL + Shift + Return.

I was hoping to use Filtering to provide a solution in VBA, but it did
not work as I expected, as you can see from the code below.

Option Explicit
Option Base 1

Public Sub TestFiltering()
Dim objFunc As WorksheetFunction
Dim lngCount As Long
Dim rngRow As Range
Dim rngRange As Range
Dim varCriteria As Variant
Dim varCol As Variant

Set objFunc = Application.WorksheetFunction

varCriteria = ">0"

' Range spans a single column for a simple list

Set rngRange = Worksheets("Sheet1").Range("B1:B20")

rngRange.AutoFilter ' Ensure filtering is off at the
start

MsgBox "Minimum value: " & objFunc.Min(rngRange), vbInformation,
"Filter not yet on"

rngRange.AutoFilter field:=1, Criteria1:=varCriteria

MsgBox "Minimum value: " & objFunc.Min(rngRange), vbInformation,
"Filter switched on - minimum zero?"

' Now try building a new column vector using the criteria

lngCount = 0

' Determine the number of rows so that we can dimension the
array initially

For Each rngRow In rngRange
If Not rngRow.EntireRow.Hidden Then
lngCount = lngCount + 1
End If
Next rngRow

ReDim varCol(lngCount)

lngCount = 0

For Each rngRow In rngRange
If Not rngRow.EntireRow.Hidden Then
lngCount = lngCount + 1
varCol(lngCount) = rngRow.Value
End If
Next rngRow

MsgBox "Minimum value: " & objFunc.Min(varCol), vbInformation,
"Filter switched on - minimum zero?"

rngRange.AutoFilter ' Finally, ensure filtering is off

Set objFunc = Nothing
Set rngRange = Nothing
Set rngRow = Nothing
End Sub

Does anyone know of a better solution without resorting to building up
an intermediate array? It is possible that I have misunderstood or
missed something that is fundamental.

Many thanks.

JAC
 
G

Gary''s Student

It might be easier to create some UDFs to implement your needs rather than
using VBA to create worksheet formulas
 
J

JAC

It might be easier to create some UDFs to implement your needs rather than
using VBA to create worksheet formulas
Click to expand...

Dear Gary's Student,

Creating UDFs is something that I tried and dismissed early on, opting
for an Update button to generate new formulae for items added since
the previous update.

It seems to me that UDFs suffer from the same problem as inserting
formulae directly. They are updated/recalculated by Excel
automatically on loading. At least the method I have adopted re-
calculates them only when required which is infrequently since the
data is historic and unlikely to change once entered.

Thanks for your input.

JAC
 
J

JAC

Dear Gary's Student,

Creating UDFs is something that I tried and dismissed early on, opting
for an Update button to generate new formulae for items added since
the previous update.

It seems to me that UDFs suffer from the same problem as inserting
formulae directly. They are updated/recalculated by Excel
automatically on loading. At least the method I have adopted re-
calculates them only when required which is infrequently since the
data is historic and unlikely to change once entered.

Thanks for your input.

JAC
Click to expand...

I tried a little experiment after writing my own function.

Private Function MinExZero(ByVal rngRange As Range) As Double
Dim objFunc As WorksheetFunction
Dim lngCount As Long
Dim rngRow As Range
Dim dblResult As Double

' This is a very "expensive" function in terms of computational
power. It slowed down performance by a factor of 7

If (rngRange Is Nothing) Then
dblResult = CVErr(xlErrNA)
Else
Set objFunc = Application.WorksheetFunction

lngCount = 0

For Each rngRow In rngRange ' Determine the
number of rows so that we can dimension the array initially
If Not rngRow.Value = 0 Then
lngCount = lngCount + 1
End If
Next rngRow

ReDim varCol(lngCount)

lngCount = 0

' Pack the array with doubles by coercing with the CDbl to
ensure the correct operation of the Min function

For Each rngRow In rngRange
If Not rngRow.Value = 0 Then
lngCount = lngCount + 1
varCol(lngCount) = CDbl(rngRow.Value)
End If
Next rngRow

dblResult = objFunc.Min(varCol)

Set objFunc = Nothing
Set rngRange = Nothing
Set rngRow = Nothing
End If

MinExZero = dblResult
End Function

When I added calls to this function, it took Excel 7 times longer than
it did when I was using the internal functions for Max, Mean, Var and
Stdev combined, such was the impact of adding filtering.

The time elapsed was very close to the time taken to incorporate
filtering using the array formula mentioned at the beginning. However,
it does have the advantage that Excel does not have to recalculate the
formula every time the workbook starts up.

It does lead to an important point that it is sometimes better to use
the functionality provided, rather than trying to invent one's own
(and sometimes inferior) solution.

JAC
 
K

keiji kounoike

How about using Subtotal function when you apply filtering.

For example, Instead of your code below,

MsgBox "Minimum value: " & objFunc.Min(rngRange), vbInformation, "Filter
switched on - minimum zero?"

use something like this.

MsgBox "Minimum value: " & objFunc.Subtotal(105, rngRange),
vbInformation, "Filter switched on - minimum zero?"

Keiji
 
J

JAC

How about using Subtotal function when you apply filtering.

For example, Instead of your code below,

MsgBox "Minimum value: " & objFunc.Min(rngRange), vbInformation, "Filter
switched on - minimum zero?"

use something like this.

MsgBox "Minimum value: " & objFunc.Subtotal(105, rngRange),
vbInformation, "Filter switched on - minimum zero?"

Keiji
Click to expand...

Keiji,

Many thanks for pointing out this elegant solution to me.

I have just tried it in my proper workbook, and it works absolutely
fine. However, it takes nearly 4 times longer to execute than the
function MinExZero that I described.

I have read the documentation carefully, and will make use of this new
insight.

Thank you very much indeed for your considered reply.

JAC
 
J

JAC

How about using Subtotal function when you apply filtering.

For example, Instead of your code below,

MsgBox "Minimum value: " & objFunc.Min(rngRange), vbInformation, "Filter
switched on - minimum zero?"

use something like this.

MsgBox "Minimum value: " & objFunc.Subtotal(105, rngRange),
vbInformation, "Filter switched on - minimum zero?"

Keiji
Click to expand...

I forgot to ask. Is there any way of switching off the messages that
appear in the Status Bar?
 
K

keiji kounoike

Put the code something like below from where you want to switch off the
messages in Status Bar

Application.StatusBar = ""

and put the code below at the place where you want to recover Status Bar

Application.StatusBar = False

Keiji
 
K

keiji kounoike

I don't know what your MinExZero function is, so why using built-in
function is so many times slower than your MinExZero.

In your TestFiltereing sub, you use two loop to pick up data excluding
0, but I think you don't need to loop. A sample code without loop is
like this.

Sub TestFiltering1()
Dim objFunc As WorksheetFunction
Dim varCriteria As Variant
Dim Vrng As Range

Application.StatusBar = ""

Set objFunc = Application.WorksheetFunction
Set rngRange = Worksheets("Sheet1").Range("B1:B20")

varCriteria = ">0"
rngRange.AutoFilter field:=1, Criteria1:=varCriteria

' Range spans a single column for a simple list

Set Vrng = rngRange.SpecialCells(xlCellTypeVisible)

MsgBox "Minimum value: " & objFunc.Min(Vrng), vbInformation, _
"Filter switched on - minimum zero ?"
MsgBox "Maximum value: " & objFunc.Max(Vrng), vbInformation, _
"Filter switched on - max zero ?"
MsgBox "Average value: " & objFunc.Average(Vrng), vbInformation, _
"Filter switched on - average zero ?"
MsgBox "Median value: " & objFunc.Median(Vrng), vbInformation, _
"Filter switched on - median zero ?"
MsgBox "Var value: " & objFunc.Var(Vrng), vbInformation, _
"Filter switched on - var zero ?"
MsgBox "Stdev value: " & objFunc.StDev(Vrng), vbInformation, _
"Filter switched on - stdev zero ?"

rngRange.AutoFilter ' Finally, ensure filtering is off

Application.StatusBar = False

End Sub

Keiji
 
J

JAC

I don't know what your MinExZero function is, so why using built-in
function is so many times slower than your MinExZero.

In your TestFiltereing sub, you use two loop to pick up data excluding
0, but I think you don't need to loop. A sample code without loop is
like this.

Sub TestFiltering1()
     Dim objFunc As WorksheetFunction
     Dim varCriteria As Variant
     Dim Vrng As Range

     Application.StatusBar = ""

     Set objFunc = Application.WorksheetFunction
     Set rngRange = Worksheets("Sheet1").Range("B1:B20")

     varCriteria = ">0"
     rngRange.AutoFilter field:=1, Criteria1:=varCriteria

     ' Range spans a single column for a simple list

     Set Vrng = rngRange.SpecialCells(xlCellTypeVisible)

     MsgBox "Minimum value: " & objFunc.Min(Vrng), vbInformation, _
         "Filter switched on - minimum zero ?"
     MsgBox "Maximum value: " & objFunc.Max(Vrng), vbInformation, _
         "Filter switched on - max zero ?"
     MsgBox "Average value: " & objFunc.Average(Vrng), vbInformation, _
         "Filter switched on - average zero ?"
     MsgBox "Median value: " & objFunc.Median(Vrng), vbInformation,_
         "Filter switched on - median zero ?"
     MsgBox "Var value: " & objFunc.Var(Vrng), vbInformation, _
         "Filter switched on - var zero ?"
     MsgBox "Stdev value: " & objFunc.StDev(Vrng), vbInformation, _
         "Filter switched on - stdev zero ?"

     rngRange.AutoFilter    ' Finally, ensure filtering is off

     Application.StatusBar = False

End Sub

Keiji
Click to expand...

Keiji,

I am grateful for the insights that you have provided.

My custom function MinExZero is in thread 4 of this discussion by the
way.

Although I have been using Excel since 1995 and VBA since 2004, I have
not made much use of auto-filtering, except at little more than a
superficial level.

Excluding zeros from minima is something of an old, well-aired
problem. Some might argue that no more need be said about it, but I am
not one for glossing over problems without giving them a lot of
thought. I tend not to accept the first solution that appears

I am glad that I pursued this case, because it has led to some useful
and unexpected discoveries on my part.

You might have thought that I would have been content with three
solutions, namely:
(a) placing an array formula in the appropriate cells, and letting
Excel do the calculations;
(b) writing my own function to exclude zeros while exploiting the
embedded Min worksheet function;
(c) using auto-filtering to build a range and passing it to the
Subtotal worksheet function, after applying the SpecialCells method
with xlCellTypeVisible as argument.

I have timed (b) and (c) on my proper workbook under closely matching
circumstances, and recorded the following results:

(b) 174s
(c) 582s

This is surprising, since (c) makes use of internal functions only,
whereas (b) is user defined by myself and contains two loops - the
first to enable the exact dimensioning of a Variant array, and the
second to pack the array.

I believe strongly that one should use internal functions wherever
possible, since they tend to execute more quickly than most user's
efforts with VBA.

Finally, I conducted another trial under similar conditions, this time
replacing the first loop in my custom function with the following
code:

varCriteria = "<>0"
lngCount = Application.WorksheetFunction.CountIf(rngRange,
varCriteria)

The result was dramatic in that the time taken dropped from 174s to
125s.

Given your interest in my problem, I thought that I would share these
findings with you and the other members of the group who have shown
interest.

Thank you once again for your help and the time that you have spent
solving this problem with me. I am grateful and hope to return the
favour sometime.

JAC
 
K

keiji kounoike

Hi JAC

Sorry for my missing your MinExZero. I make another two function,
MinExZero1 and MinExZero2. In the three, I think MinExZero1 would be the
fastest. When you want other function like Avreage, var and stdev with
excluding specific value, I think UDF with combinations of built-in
function like countif and sumif etc is faster.

Function MinExZero1(ByVal rng As Range) As Double
Dim objFunc As WorksheetFunction

Set objFunc = Application.WorksheetFunction
With objFunc
MinExZero1 = .Min(rng)
If MinExZero1 = 0 Then
MinExZero1 = .Small(rng, .CountIf(rng, "=0") + 1)
End If
End With

End Function

Function MinExZero2(ByVal rng As Range) As Variant
MinExZero2 = Evaluate("=min(if(" & rng.Address & "<>0," _
& rng.Address & ",""""))")
End Function

Keiji
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Find string from column A in Range("B2:F7") list the header of that column/s 5

Top