![]() |
Finding the minimum value in a list but excluding zeros - a variationon an old problem
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 |
Finding the minimum value in a list but excluding zeros - a variat
It might be easier to create some UDFs to implement your needs rather than
using VBA to create worksheet formulas -- Gary''s Student - gsnu201001 "JAC" wrote: 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 . |
Finding the minimum value in a list but excluding zeros - avariat
On 25 Feb, 12:42, Gary''s Student
wrote: It might be easier to create some UDFs to implement your needs rather than using VBA to create worksheet formulas -- Gary''s Student - gsnu201001 "JAC" wrote: 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 . 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 |
Finding the minimum value in a list but excluding zeros - avariat
On 25 Feb, 13:10, JAC wrote:
On 25 Feb, 12:42, Gary''s Student wrote: It might be easier to create some UDFs to implement your needs rather than using VBA to create worksheet formulas -- Gary''s Student - gsnu201001 "JAC" wrote: 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 . 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 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 |
Finding the minimum value in a list but excluding zeros - a variationon an old problem
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 JAC wrote: 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 |
Finding the minimum value in a list but excluding zeros - avariation on an old problem
On 1 Mar, 00:50, keiji kounoike <"kounoike A | T ma.Pikara.ne.jp"
wrote: 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 JAC wrote: 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 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 |
Finding the minimum value in a list but excluding zeros - avariation on an old problem
On 1 Mar, 00:50, keiji kounoike <"kounoike A | T ma.Pikara.ne.jp"
wrote: 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 JAC wrote: 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 I forgot to ask. Is there any way of switching off the messages that appear in the Status Bar? |
Finding the minimum value in a list but excluding zeros - avariation on an old problem
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 JAC wrote: On 1 Mar, 00:50, keiji kounoike <"kounoike A | T ma.Pikara.ne.jp" wrote: 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 JAC wrote: 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 I forgot to ask. Is there any way of switching off the messages that appear in the Status Bar? |
Finding the minimum value in a list but excluding zeros - avariation on an old problem
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 JAC wrote: On 1 Mar, 00:50, keiji kounoike <"kounoike A | T ma.Pikara.ne.jp" wrote: 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 JAC wrote: 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 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 |
Finding the minimum value in a list but excluding zeros - avariation on an old problem
On 2 Mar, 02:18, keiji kounoike <"kounoike A | T ma.Pikara.ne.jp"
wrote: 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 JAC wrote: On 1 Mar, 00:50, keiji kounoike <"kounoike A | T *ma.Pikara.ne.jp" wrote: 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 JAC wrote: 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 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 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 |
Finding the minimum value in a list but excluding zeros - avariation on an old problem
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 JAC wrote: On 2 Mar, 02:18, keiji kounoike <"kounoike A | T ma.Pikara.ne.jp" wrote: 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 JAC wrote: On 1 Mar, 00:50, keiji kounoike <"kounoike A | T ma.Pikara.ne.jp" wrote: 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 JAC wrote: 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 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 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 |
All times are GMT +1. The time now is 11:14 AM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com