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:B200,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:B200,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