Get Max and Min Values from a dynamic Array

Topic

New Reply

A model calculates a worksheet a number of times and outputs the results to an array. The array is re-dimensioned at startup based on number of calculations required. At present after calculation it enters the data into a worksheet and then finds the max and min from the values in the worksheet range. What I would like to do i skip having to enter data and return the max and min values form the array. everything I have tried so far either returns 0 or the max value for both min and max.

I would also like to sort the array and return all the bins without entering them in the worksheet but one thing at a time .

Thanks very much

This is the code I am using

Code:

Sub Recalculate() ‘Recalculates the WorkBook
Dim Calc_
Worksheets(startSht).Select
Set Output = Application.InputBox(prompt:=”Please select the 1st Output Range.”, Title:=”SPECIFY RANGE”, Type:=8)
Set OutPutLabel = Application.InputBox(prompt:=”Please select Label for the 1st Output Range.”, Title:=”SPECIFY RANGE”, Type:=8)
Output = Output.Address
Dim rt
Worksheets(wsC).Select      ‘Name in WB of the sheet to be used
Cells.Select                            ‘Just to make sure no data
Selection.ClearContents
Range(“A1”).Select
rt = InputBox(“No Calcs”)       ‘Asks for number of times to recalculate
ReDim Calc_(rt)                     ‘Redimensions the array to number of calcs to be done
For i = 1 To rt                         ‘Loops number of calcualtions
    Application.Calculate           ‘Recalculates workbook
    Calc_(i) = Worksheets(“Results”).Range(Output).Value  ‘Range  value
Next i
For i = 1 To rt                         ‘Enters data from array into stats worksheet
    Worksheets(wsC).Range(“A” & i).Value = Calc_(i)
Next i
Columns(“A:D”).NumberFormat = “$#,##0”
Call QuickSort(Calc_, LBound(Calc_), UBound(Calc_)) ‘Calls QuickSort to sort the results into ascending order
For i = 1 To rt                         ‘ ‘Loops number of calcualtions in the sorted array
        Worksheets(wsC).Range(“B” & i).Value = Calc_(i) ‘Enters data from array into stats worksheet
Next i
Perstep = 0.05
Columns(“C”).NumberFormat = “#0%”
For i = 1 To 20
    Worksheets(wsC).Range(“c” & i).Value = Perstep
    If i = 20 Then  ‘Required does not like it if it runs to 1 by addition LOOK INTO
        Worksheets(wsC).Range(“D” & i).Value = Application.WorksheetFunction.Percentile(Range(Cells(1, 2), Cells(rt, 2)), 1)
    Else
        Worksheets(wsC).Range(“D” & i).Value = Application.WorksheetFunction.Percentile(Range(Cells(1, 2), Cells(rt, 2)), Perstep)
        Perstep = Perstep + 0.05
    End If
Next i
Maxv = Application.WorksheetFunction.Max(Cells(1, 2), Cells(rt, 2))
MinV = Application.WorksheetFunction.Min(Cells(1, 2), Cells(rt, 2))
Maxv = Application.WorksheetFunction.RoundUp(Maxv, -6)
MinV = Application.WorksheetFunction.RoundDown(MinV, -6)
StepV = (Maxv – MinV) / 20
MinV = MinV – StepV
For i = 1 To 20
    Worksheets(wsC).Range(“E” & i).Value = MinV
    MinV = MinV + StepV
Next i
Range(Range(“B1”), Range(“B1”).End(xlDown)).Select
Selection.Name = “Data1”
Range(Range(“E1”), Range(“E1”).End(xlDown)).Select
‘Set newrange = Range(ActiveCell, ActiveCell.End(xlDown))
‘newrange.Select
Selection.Name = “Bins1”
Set FrequencyArray = Worksheets(wsC).Range(Cells(1, 6), Cells(20, 6))
FrequencyArray.FormulaArray = “=frequency(Data1,Bins1)”
End Sub

Reply | Quote

Replies

To find the Min & max values in an array, there’s no need to sort the array or output the data to a worksheet. For example:

Code:

Sub Demo()
Dim i As Long, SngMin As Single, SngMax As Single, ArrData()
ReDim Preserve ArrData(100)
For i = LBound(ArrData) To UBound(ArrData)
  ArrData(i) = CSng(Rnd * 100 - 50)
Next
For i = LBound(ArrData) To UBound(ArrData)
  If SngMin  ArrData(i) Then SngMax = ArrData(i)
Next
MsgBox "Min: " & SngMin & vbTab & "Max: " & SngMax
End Sub

Cheers,
Paul Edstein
[Fmr MS MVP - Word]

Reply | Quote

Paul

Thanks for taking the trouble to look at my problem I was rather hoping there would be a way of avoiding the loop. i have had to make a couple of alterations to your code because when I fed my data in I keep getting a zero value . I guess that’s because the first position in an array is 0. Also I could not get it to work unless I allowed for the fact that SngMin would always be less than my data (unless of course my data had a less than zero result). Fixed it by simple setting SngMin on the first iteration to whatever the value of the first position in the array was.

An imposition I know but I also want to return a number of percentiles from the same array and I cannot figure out how to to that even with a loop do you have any thoughts. I do that a present as you can see form my earlier code by entering the data in a worksheet.

Again my thanks this is my revision to your code.

Code:

Sub Demo()
Dim i As Long, SngMin As Single, SngMax As Single, ArrData()
ActiveSheet.Select
Cells.Select
Selection.ClearContents
Range(“A1”).Select
ReDim Preserve ArrData(10)
For i = LBound(ArrData) + 1 To UBound(ArrData)
    ‘ArrData(i) = CSng(Rnd * 100 – 50)
    ArrData(i) = Worksheets(“results”).Range(“F4”).Value
    Application.Calculate
    ‘ActiveSheet.Range(“A” & i + 1).Value = ArrData(i)
Next
For i = LBound(ArrData) + 1 To UBound(ArrData)
    If SngMin = 0 Then
        SngMin = ArrData(i)
        Else
        If ArrData(i)  SngMax Then SngMax = ArrData(i)
Next
MsgBox “Final Min: ” & SngMin & vbTab & “Max: ” & SngMax
End Sub

Reply | Quote

Thanks for taking the trouble to look at my problem I was rather hoping there would be a way of avoiding the loop.[/quote]
But your own code already uses three loops. It also calls a Quicksort routine that doubtless uses at least one loop of its own. Besides, how else to you suppose you’d process the array elements?
[Quote]i have had to make a couple of alterations to your code because when I fed my data in I keep getting a zero value . I guess that’s because the first position in an array is 0. Also I could not get it to work unless I allowed for the fact that SngMin would always be less than my data (unless of course my data had a less than zero result). Fixed it by simple setting SngMin on the first iteration to whatever the value of the first position in the array was.[/Quote]
That could be handled by adding:
Option Base 1
to the code module or by changing:
LBound(ArrData)
to:
1
without any of the circumlocution your code uses! And, if you call your Quicksort routine after populating the array, the first and last elements will be the Min and Max values, respectively – without any further processing.
[Quote]I also want to return a number of percentiles from the same array and I cannot figure out how to to that even with a loop

Again, if you call your Quicksort routine after populating the array, you can simply read back the xth, yth, zth, etc. elements. If they’re at 25% intervals of the array size, you’ll now have the 0% (Min), 25%, 50%, 75% and 100% (Max) values. I’m not sure what else you might mean by percentiles, but that should give you an idea:

Code:

Option Explicit
Option Base 1

Sub Demo()
Dim i As Long, ArrData()
i = CLng(InputBox("No Calcs"))     'Ask for number of times to recalculate
ReDim Preserve ArrData(i)
If i < 1 Then Exit Sub
ActiveSheet.ClearContents
For i = LBound(ArrData) To UBound(ArrData)
  ArrData(i) = Worksheets("Results").Range("F4").Value
  Application.Calculate
Next
Call QuickSort(ArrData, LBound(ArrData), UBound(ArrData))
MsgBox "Min: " & ArrData(1) & vbTab & vbCr & _
  "25%: " & ArrData(Round(UBound(ArrData) / 4)) & vbCr & _
  "50%: " & ArrData(Round(UBound(ArrData) / 2)) & vbCr & _
  "75%: " & ArrData(Round(UBound(ArrData) / 4 * 3)) & vbCr & _
  "Max: " & ArrData(UBound(ArrData))
End Sub

Cheers,
Paul Edstein
[Fmr MS MVP - Word]

Reply | Quote

Paul

Thank you, you are of course correct there are a number of loops and I was trying to avoid entering data into the worksheet and the loops if possible as that slows processing down. I was trying to ditch the quick sort for the same reason . I have not been able to figure out how long the sort takes. When you say my codes is circumlocutory are you referring to the original or my use of the if then to deal with the zero value. The percentile was to set up the bins for a histogram and I wanted the user to be able to specify how many they wanted.

Thank you

Reply | Quote

I was trying to avoid entering data into the worksheet and the loops if possible as that slows processing down.

Processing data on a worksheet is liable to be much slower than processing in memory, even if the latter uses extra loops.

I was trying to ditch the quick sort for the same reason . I have not been able to figure out how long the sort takes.

Without knowing more about how you’re going to use the data, I can’t even say whether it needs sorting – my last post assumed you need it sorted for the percentiles.

When you say my codes is circumlocutory are you referring to the original or my use of the if then to deal with the zero value.

I was referring to your code in post#3.

The percentile was to set up the bins for a histogram and I wanted the user to be able to specify how many they wanted.

My last post shows one way of getting the percentiles at 25% intervals. If you want variable intervals, obviously you’d need code to read the data at those intervals and, for that a loop is probably the most efficient way (simply divide the array side and read every nth element). Unless you want a huge number of percentiles from a massive data set, you’d be hard-pressed to notice the time it takes, especially in comparison with a loop that employs reading data from a recalculating worksheet.

Try:

Code:

Sub Demo()
'Note: One more item is calculated than the # requested.
'This is analogous to the # of pickets in an x-length
'picket fence at y intervals being x/y+1.
'The first output element will be item 0.
Dim i As Long, j As Long, k As Long, ArrData(), StrOut
'Ask for number of percentiles to report
i = CLng(InputBox("No Data Points"))
If i < 1 Then Exit Sub
'Ask for number of times to recalculate
j = CLng(InputBox("No Calcs, in multiples of " & i))
If j < 1 Then Exit Sub
j = -Int(-j / i) * i
ReDim Preserve ArrData(j)
For k = LBound(ArrData) To UBound(ArrData)
  ArrData(k) = Worksheets("Results").Range("F4").Value
  Application.Calculate
Next
Call QuickSort(ArrData, LBound(ArrData), UBound(ArrData))
For k = LBound(ArrData) To UBound(ArrData) Step j / i
  StrOut = StrOut & k & vbTab & ArrData(k) & vbCr
Next
ActiveSheet.UsedRange.ClearContents
MsgBox StrOut
End Sub

Cheers,
Paul Edstein
[Fmr MS MVP - Word]

Reply | Quote

Paul

This may be the wrong place to post but as I was working on the code you gave me I thought I would try. First though some clarification I wanted to calculate all the possibilities before I used that data to assign percentile ranges. I have done that with your help and as you suggested its a lot easier to get the min and max after the bubble sort. As I want to check whats happening I am still entering the results into the worksheet. I reworked your code to collect the data in an array then the results ingot percentile bins another array. The problem I now have is very strange . I wanted the user to be able to specify the number of bins but discovered the code I was using just did not work on certain numbers I checked from 2 to 30 and 9,11,18,20,21 and 25 resulted in an error. I know the percentile function does not work past 1 for obvious reasons and assumed it was some type of rounding error but that cannot be the case for 20. Anyway I have put in a clumsy error handler to set the last percentile to 1.

Code:

Sub Demo4()
Dim i As Long, ArrData() As Double, reClac, rePer As Double, ArrBins() As Double
    ActiveSheet.Select
    Cells.Select
    Selection.ClearContents
    Range(“A1”).Select
    reCalc = InputBox(“No Calcs”)
    ReDim Preserve ArrData(reCalc)
    rePer = InputBox(“No of Bins”)
    ReDim Preserve ArrBins(rePer)
    For i = 1 To UBound(ArrData)
        ArrData(i) = Worksheets(“results”).Range(“F4”).Value
        Application.Calculate
        ActiveSheet.Range(“A” & i + 1).Value = ArrData(i)
    Next
    Call QuickSort(ArrData, LBound(ArrData), UBound(ArrData))
    Range(“a1”).Value = ArrData(1)
    Range(“b1”).Value = ArrData(reCalc)
    PerStep = 1 / rePer
 
    For i = 1 To rePer
        On Error GoTo errHandler: ‘Problem withc ertain numbers that generates an error on the last iteration when perstep should be 1
        ArrBins(i) = Application.WorksheetFunction.Percentile(ArrData, PerStep)
        PerStep = PerStep + 1 / rePer
        ActiveSheet.Range(“B” & i + 1).Value = ArrBins(i)
    Next i
    Exit Sub
errHandler:
 PerStep = 1
Resume
End Sub

Again my apologies if this is in the wrong place.

Peter

Reply | Quote

Paul

Thanks again this will help me streamline what I have done. I only want to run the recalculations once . The object of my exercise is to produce the data and the bins to build a histogram to check the distribution, it is part of a Monte Carlo Analysis. I had it working as clumsy as my code was but taking for ever and could not have more than 64K iterations because it need to enter the data in a worksheet.

Must learn to read code carefully I ran yours and managed to clear all the info on my results page , luckily a backup was available.

Again my thanks

Peter

Reply | Quote

Try replacing:
ActiveSheet.UsedRange.ClearContents
with:
Worksheets(wsC).UsedRange.ClearContents

Cheers,
Paul Edstein
[Fmr MS MVP - Word]

Reply | Quote

It seems to me you should be able to use:

Code:

Sub Demo5()
Dim i As Long, reCalc As Long, rePer As Long
Dim ArrData() As Double, ArrBins() As Double
If ActiveSheet.Name = "results" Then Exit Sub
reCalc = InputBox("No Calcs")
rePer = InputBox("No of Bins")
ReDim ArrData(reCalc)
ReDim ArrBins(rePer)
With ActiveSheet
    .UsedRange.ClearContents
    For i = 1 To reCalc
        ArrData(i) = Worksheets("results").Range("F4").Value
        .Calculate
        .Range("A" & i + 1).Value = ArrData(i)
    Next
    .Range("A1").Value = Application.WorksheetFunction.Min(.Range("A2:A" & reCalc + 1))
    .Range("B1").Value = Application.WorksheetFunction.Max(.Range("A2:A" & reCalc + 1))
    For i = 1 To rePer
        ArrBins(i) = Application.WorksheetFunction.Percentile(ArrData, i / rePer)
        .Range("B" & i + 1).Value = ArrBins(i)
    Next i
End With
End Sub

Note: By using the built-in Min & Max functions, there is no need for the QuickSort.

Cheers,
Paul Edstein
[Fmr MS MVP - Word]

Reply | Quote

Paul

Thank you again, I have found the percentile does not work I need to to take the min and max and build the bins smoothly between the two. I was hoping to dump the quick sort but when i do for some reason the frequency distribution just does not work. My smoothing is clumsy and you will see that I had to make sure the last one was at lest equal to the largest number in the data set. In the end I want to produce a Histogram and calculate std dev etc so I will not write data to the worksheet if I don’t have to as I assume that speeds the process up.

Below is the code which appears to be working OK, I would not have got there without your help thank you.:o

Code:

Sub Demo6() ‘Working 05242014
Dim i As Long, ArrData() As Double, reClac, rePer As Double, ArrBins() As Double, StepB
    ActiveSheet.Select
   Cells.Select
    Selection.ClearContents
    Range(“A2”).Select
    reCalc = InputBox(“No Calcs”)
    ReDim Preserve ArrData(reCalc – 1)
    rePer = InputBox(“No of Bins”)
    ReDim Preserve ArrBins(rePer – 1)
    For i = LBound(ArrData) To UBound(ArrData)
        Application.Calculate
        ArrData(i) = Worksheets(“results”).Range(“F4”).Value
        ActiveSheet.Range(“A” & i + 2).Value = ArrData(i)
    Next
    Call QuickSort(ArrData, LBound(ArrData), UBound(ArrData))
    Lb = ArrData(0)
    Lb = Len(Int(Lb))
    Call RoundingLower
    Ub = ArrData(reCalc – 1)
    Ub = Len(Int(Ub))
    Call RoundingHigher
    Lb = WorksheetFunction.RoundDown(ArrData(0), Rd)
    Ub = WorksheetFunction.RoundUp(ArrData(reCalc – 1), Rd)
    StepB = (Ub – Lb) / (rePer – 1)
StepB1 = WorksheetFunction.RoundDown(StepB, -4)
StepB2 = WorksheetFunction.RoundUp(StepB, -4)
StepB = (StepB1 + StepB2) / 2
Range(“D2”).Select
For i = 0 To UBound(ArrBins)
    ArrBins(i) = Lb
    Lb = Lb + StepB
    Selection = ArrBins(i)
    ActiveCell.Offset(1, 0).Select
Next i
If UBound(ArrBins) < Ub Then
ArrBins(rePer – 1) = Ub
ActiveCell.Offset(-1, 0).Select
Selection = Ub
End If

Set frequencyarray = Range("E2:E21")
frequencyarray.FormulaArray = WorksheetFunction.Frequency(ArrData, ArrBins)
Range("E22").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-20]C:R[-1]C)"
End Sub

Reply | Quote