Get Max and Min Values from a dynamic Array
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
Sub Recalculate() 'Recalculates the WorkBook
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
Worksheets(wsC).Select 'Name in WB of the sheet to be used
Cells.Select 'Just to make sure no data
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
For i = 1 To rt 'Enters data from array into stats worksheet
Worksheets(wsC).Range("A" & i).Value = Calc_(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
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)
Worksheets(wsC).Range("D" & i).Value = Application.WorksheetFunction.Percentile(Range(Cells(1, 2), Cells(rt, 2)), Perstep)
Perstep = Perstep + 0.05
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
Selection.Name = "Data1"
'Set newrange = Range(ActiveCell, ActiveCell.End(xlDown))
Selection.Name = "Bins1"
Set FrequencyArray = Worksheets(wsC).Range(Cells(1, 6), Cells(20, 6))
FrequencyArray.FormulaArray = "=frequency(Data1,Bins1)"
Percentile function Does not work with some numbers
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.
Again my apologies if this is in the wrong place.
Dim i As Long, ArrData() As Double, reClac, rePer As Double, ArrBins() As Double
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
ActiveSheet.Range("A" & i + 1).Value = ArrData(i)
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)
PerStep = 1