Using collection instead of array

tiredofit

Well-known Member
Joined
Apr 11, 2013
Messages
1,913
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
I have 10 rows of data in column A.

I can calculate the upper quartile as follows:

Rich (BB code):
Dim MyArray() As Variant

MyArray() = Cells(1, 1).CurrentRegion.Value

Dim UQ As Double

UQ = Application.WorksheetFunction.Quartile_Exc(MyArray(), 3)

If instead of using an array, I choose to use a collection, like this:

Rich (BB code):
Dim MyColl As Collection
Set MyColl = New Collection

Dim Counter As Integer

For Counter = 1 to 10

    MyColl.Add Cells (Counter, 1).Value

Next Counter

Dim UQ As Double UQ = Application.WorksheetFunction.Quartile_Exc(MyColl, 3)


it does not work and fails on this line:

Rich (BB code):
UQ = Application.WorksheetFunction.Quartile_Exc(MyColl, 3)<strike>

</strike><strike>


</strike>

I assume the reason is the first argument of Quartile_Exc expects an array? So does that defeat the object of using a collection instead of an array?

Thanks
 
Last edited:

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
You'd have to create an array (or populate cells) for it to work, so I don't see the point in using a collection at all.
 
Upvote 0
Thanks.

Using arrays only, I was declaring a dynamic array that was far bigger than what I needed (I tend not to use Redim preserve).
 
Upvote 0
You haven't provided any real info as to why, but generally you can either determine the necessary size at the start, or just use one Redim Preserve at the end.
 
Upvote 0
You haven't provided any real info as to why, but generally you can either determine the necessary size at the start, or just use one Redim Preserve at the end.

I have two columns of data: column A is Name, column B is Amount.

I want to create the LQ and UQ metrics on the set of data where the Name is the same, hence I used a SubArray but I don't know how large it's going to be, I have declared it as big as the original data.

This algorithm works EXCEPT for a small point: If the last value in the data is an outlier, it won't identify it, probably because my loop goes from the Start to the End - 1.

How can I correct it?

For example, if my data was:

Code:
Name    Amount

a          2
a          2
a          2
a          2
a          20

LQ = 2, UQ = 11 and clearly the last value (20) is an outlier but the code won't pick it up.


Here's the full code:

Code:
Option Explicit

    Dim DataArray() As Variant
    
    DataArray() = Sheet1.Cells(1, 1).CurrentRegion.Value
    
    Dim DataArrayRows As Double
    
    DataArrayRows = UBound(DataArray(), 1)
    
    Dim DataArrayCols As Integer
    
    DataArrayCols = UBound(DataArray(), 2)
    
    Dim SubArray() As Variant
    
    ReDim SubArray(1 To DataArrayRows, 1 To 1) As Variant
    
    Dim TempArray() As Variant
    
    ReDim TempArray(1 To DataArrayRows, 1 To 2) As Variant
    
    Dim DataArrayRowCount As Integer, SubArrayRowCount As Integer, SameNumberCount As Integer, SameNumberStartRow As Long, SameNumberBlock As Long, TempArrayRow As Integer, DataArrayColCount As Integer
    
    Dim LowerQuartile As Double, UpperQuartile As Double
    
    Dim IQR As Double
    
    SameNumberStartRow = 2
    
    TempArrayRow = 1
    
    For DataArrayRowCount = 2 To DataArrayRows - 1
                
        SubArrayRowCount = 1
        
        SameNumberCount = 1
        
        Do Until DataArray(DataArrayRowCount, 1) <> DataArray(DataArrayRowCount + 1, 1)
            
            SubArray(SubArrayRowCount, 1) = DataArray(DataArrayRowCount, 2)
            
            SameNumberCount = SameNumberCount + 1
            
            DataArrayRowCount = DataArrayRowCount + 1
            
            SubArrayRowCount = SubArrayRowCount + 1
            
            If DataArrayRowCount > DataArrayRows - 1 Then Exit Do
            
        Loop
        
        SubArray(SubArrayRowCount, 1) = DataArray(DataArrayRowCount, 2)
        
        If SameNumberCount > 2 Then
        
            With Application.WorksheetFunction
    
                LowerQuartile = .Quartile_Exc(SubArray(), 1)
                UpperQuartile = .Quartile_Exc(SubArray(), 3)
    
                IQR = UpperQuartile - LowerQuartile
    
            End With
            
            For SameNumberBlock = SameNumberStartRow To DataArrayRowCount
            
                If DataArray(SameNumberBlock, 2) < LowerQuartile - IQR * 1.5 Or _
                   DataArray(SameNumberBlock, 2) > UpperQuartile + IQR * 1.5 Then
                    TempArray(TempArrayRow, 1) = DataArray(SameNumberBlock, 1)
                    TempArray(TempArrayRow, 2) = DataArray(SameNumberBlock, 2)
                    
                    TempArrayRow = TempArrayRow + 1
                    
                    For DataArrayColCount = 1 To DataArrayCols
                    
                        DataArray(SameNumberBlock, DataArrayColCount) = vbNullString
                        
                    Next DataArrayColCount
                    
                End If
                
            Next SameNumberBlock
            
        End If
        
        ReDim SubArray(1 To DataArrayRows, 1 To 1) As Variant
        
        SameNumberStartRow = DataArrayRowCount + 1
        
    Next DataArrayRowCount
    
    Sheet1.Cells(1, 13).Resize(DataArrayRows, DataArrayCols).Value = DataArray()
    
    Erase DataArray()
    
    Erase SubArray()
    
    Erase TempArray()
 
Last edited:
Upvote 0
I don't have time to go through all of that but at a quick glance it looks like you'd be better off using a Dictionary to hold arrays of data for each name. You can either resize the arrays as you go, at the end, or use Countif to figure out how many items there are for each name.
 
Upvote 0

Forum statistics

Threads
1,223,367
Messages
6,171,672
Members
452,416
Latest member
johnog

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