Results 1 to 11 of 11
  1. #1
    2 Star Lounger
    Join Date
    Apr 2003
    Location
    Vail, Colorado, USA
    Posts
    173
    Thanks
    27
    Thanked 0 Times in 0 Posts

    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


    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

  2. #2
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    3,944
    Thanks
    0
    Thanked 203 Times in 184 Posts
    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 SngMin = ArrData(i)
      If SngMax > ArrData(i) Then SngMax = ArrData(i)
    Next
    MsgBox "Min: " & SngMin & vbTab & "Max: " & SngMax
    End Sub
    Last edited by macropod; 2014-05-17 at 05:09.
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  3. #3
    2 Star Lounger
    Join Date
    Apr 2003
    Location
    Vail, Colorado, USA
    Posts
    173
    Thanks
    27
    Thanked 0 Times in 0 Posts

    Some Variations

    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) < SngMin Then SngMin = ArrData(i)
        End If
            If ArrData(i) > SngMax Then SngMax = ArrData(i)
    Next
    MsgBox "Final Min: " & SngMin & vbTab & "Max: " & SngMax
    End Sub

  4. #4
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    3,944
    Thanks
    0
    Thanked 203 Times in 184 Posts
    Quote Originally Posted by mitchbvi View Post
    Thanks for taking the trouble to look at my problem I was rather hoping there would be a way of avoiding the loop.
    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?
    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.
    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.
    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
    [MS MVP - Word]

  5. The Following User Says Thank You to macropod For This Useful Post:

    mitchbvi (2014-05-18)

  6. #5
    2 Star Lounger
    Join Date
    Apr 2003
    Location
    Vail, Colorado, USA
    Posts
    173
    Thanks
    27
    Thanked 0 Times in 0 Posts
    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

  7. #6
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    3,944
    Thanks
    0
    Thanked 203 Times in 184 Posts
    Quote Originally Posted by mitchbvi View Post
    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
    [MS MVP - Word]

  8. The Following User Says Thank You to macropod For This Useful Post:

    mitchbvi (2014-05-19)

  9. #7
    2 Star Lounger
    Join Date
    Apr 2003
    Location
    Vail, Colorado, USA
    Posts
    173
    Thanks
    27
    Thanked 0 Times in 0 Posts
    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
    Last edited by mitchbvi; 2014-05-19 at 09:43.

  10. #8
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    3,944
    Thanks
    0
    Thanked 203 Times in 184 Posts
    Try replacing:
    ActiveSheet.UsedRange.ClearContents
    with:
    Worksheets(wsC).UsedRange.ClearContents
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  11. The Following User Says Thank You to macropod For This Useful Post:

    mitchbvi (2014-05-22)

  12. #9
    2 Star Lounger
    Join Date
    Apr 2003
    Location
    Vail, Colorado, USA
    Posts
    173
    Thanks
    27
    Thanked 0 Times in 0 Posts

    Percentile function Does not work with some numbers

    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
    Last edited by mitchbvi; 2014-05-23 at 11:32.

  13. #10
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    3,944
    Thanks
    0
    Thanked 203 Times in 184 Posts
    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
    [MS MVP - Word]

  14. The Following User Says Thank You to macropod For This Useful Post:

    mitchbvi (2014-05-24)

  15. #11
    2 Star Lounger
    Join Date
    Apr 2003
    Location
    Vail, Colorado, USA
    Posts
    173
    Thanks
    27
    Thanked 0 Times in 0 Posts

    Red face Quicksort still needed

    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.
    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

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •