VBA Array - Minimum value & quartile

smetje_desmet

New Member
Joined
Apr 6, 2016
Messages
5
Hi all

I'm trying to generate some box-plots of data that meets several requirements.
Basically, I'm looping all data in shData, see if the value meets the conditions and if so, add the cell content to an array. Once the array is filled, I print min, max, avg... so I can make a boxplot.

Now it seems that the array I've made / filled doesn't respond well to some worksheetfunctions (read: none ?)

Code:
   'All necessary variables are declared above        
   
   Dim shData As Worksheet, shOverview As Worksheet
   
       
    'Start calculations
    For k = 4 To (iColumn - 1) 'For as long as there are dates to evaluate
        shOverview.Select ' working in the correct sheet
        Startdate = shOverview.Cells(4, k) 'in column k, row 4 is the startdate
        EndDate = shOverview.Cells(5, k) 'in column k, row 5 is the enddate
        
        'i = 7 Start of table "thickness range" (purely for convenience of the sheet-layout, protected sheet in endues)
        For i = 7 To shOverview.Range("a" & Rows.Count).End(xlUp).Row 'For as long as there are parameters to evaluate in row a ...
            On Error Resume Next 'Title rows --> not a searcheable string --> skip

            iParameter = fncTranslateParameter(shOverview.Cells(i, 1)) 'iParameter returns the column number of shData in which the desired data is (basically a vlookup function)

            'Only if the evaluated parameter in the evaluated cell is available in sheet "selection criteria" (see vlookup)
            If (iParameter <> 0) Then

                'Initialize all necessary variables to be printed
                iCount = 0
                dblGemiddelde = 0
                dblSum = 0
                dblStdDev = 0
                dblMin = 10000 'I know this is ugly programming, but here lies the problem
                dblMax = 0 'Same remark


                'Evaluate line per line of shData --> if value is valid, do some calculations
                For j = 1 To shData.Range("a" & Rows.Count).End(xlUp).Row 'From row 1 to (amount of rows in sheet "data")
                    If (shData.Cells(j, 2) >= CDbl(Startdate) And shData.Cells(j, 2) <= CDbl(EndDate)) Then 'Correct data range
                        If (shData.Cells(j, fncTranslateParameter("Dikte")) >= shOverview.Cells(i, 2) And shData.Cells(j, fncTranslateParameter("Dikte")) < shOverview.Cells(i, 3)) Then 'it is the valid thickness range
                            If (shData.Cells(j, iParameter) <> 0 And Len(shData.Cells(j, iParameter)) > 0) Then
                                iCount = iCount + 1
                                If shData.Cells(j, iParameter) < dblMin Then dblMin = shData.Cells(j, iParameter)
                                If shData.Cells(j, iParameter) > dblMax Then dblMax = shData.Cells(j, iParameter)
                                ReDim Preserve aValues(iCount) As Double
                                    aValues(iCount) = shData.Cells(j, iParameter) 'This actually works, I can print aValues() with a loop or something
                                dblSum = dblSum + aValues(iCount)
                            End If 'empty cell or zero
                        End If 'not the required thickness
                    End If 'not in the required date-range
                Next 'j loop --> Evaluate the next line in shData


                'Fill in the i-th line & line i until i+5 (necessary boxplot values)
                shOverview.Select
                If (iCount > 0) Then
                        dblGemiddelde = dblSum / UBound(aValues) ' average calculation
                        For a = 1 To UBound(aValues()) 'stdDev calculation
                            dblStdDev = dblStdDev + (aValues(a) - dblGemiddelde) ^ 2
                        Next
                    Cells(i + 0, k) = Round(dblMin, 1) 'Round(dblGemiddelde, 1) 'WORKS
                    Cells(i + 1, k) = Round(Application.WorksheetFunction.Quartile(aValues(), 0), 1) 'Round(Application.WorksheetFunction.Quartile(aValues(), 1), 1) 'Bottom = Q1 ' RETURNS 0
                    Cells(i + 2, k) = Round(Application.WorksheetFunction.Min(aValues()), 1) 'Round(Application.WorksheetFunction.Quartile(aValues(), 2) - Application.WorksheetFunction.Quartile(aValues(), 1), 1) 'Q2 box = median - Q1 ' RETURNS 0
                    Cells(i + 3, k) = Round(Application.WorksheetFunction.Small(aValues(), 1), 1) 'Round(Application.WorksheetFunction.Quartile(aValues(), 3) - Application.WorksheetFunction.Quartile(aValues(), 2), 1) 'Q3 box = Q3- median ' RETURNS 0
                    Cells(i + 4, k) = "a" 'Round(Application.WorksheetFunction.Quartile(aValues(), 1) - dblMin, 1) 'whisker - ' calculation wrong, for debugging purposes
                    Cells(i + 5, k) = "a" 'Round(dblMax - Application.WorksheetFunction.Quartile(aValues(), 3), 1) 'whisker + ' calculation wrong, for debugging purposes
                End If 'iCount was not zero --> line was filled in
            i = i + 5 'because I fill in 5 rows per evaluated parameter
            End If 'iParameter was not zero --> no error
            iParameter = 0
        Next 'i loop --> rows with data to evaluate
    Next 'k loop --> columns 4 to (iColumn-1)
    
    shOverview.Select

    Application.ScreenUpdating = True

Any help would be greatly appreciated
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
Solved

I needed a friendly reminder that VBA counts array indices from 0, so aValues(0) = 0 (default set if you start filling aValues from 1), which is indeed the minimum value if only positive integers are possible.

Quartile functions, min and small all return the correct value.

Another reminder: UBound( array ) = (number of elements) - 1

-Tim
 
Upvote 0

Forum statistics

Threads
1,213,557
Messages
6,114,288
Members
448,563
Latest member
MushtaqAli

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top