CODEWITHSUNDEEP
excelvba
He Hui
He Hui

Reputation: 2236

Finding mode of an array in VBA

I am trying to find the mode of an array in VBA.

Assume that there is a dynamic list of movie titles. A:A, and there is a just-as-long list B:B, which is a list of movie "types".

I am trying to find the top most repeated titles, of a certain type.

Note: A:A is a dynamic list, and I don't know it's length.

---------------------------------
-Finding Nemo  - Cartoon 
-Finding Nemo  - Cartoon
-Finding Nemo  - Cartoon
-Finding Nemo  - Cartoon
-Finding Nemo  - Cartoon
-Inception     - Action
-Inception     - Action
-Inception     - Action
-Dragon Ball   - Cartoon
-Dragon Ball   - Cartoon
-Dragon Ball   - Cartoon 
---------------------------------

Take this table for example, Finding Nemo is the most occurred title. But now do I write a function to return that result?

I am assuming a function similar to this:

=movieMode(5)

Where 5 specifies the number of "top" results I want returned.

The problem here is I don't know how to do this when A:A is at dynamic length. And how to control how many results are to be returned. I should set a filter which only searches "cartoons" by default.

Please share some light on this.

Update

After some research, I found this formula.

=INDEX(A2:A177,MATCH(MAX(COUNTIF(A2:A177,A2:A177)),COUNTIF(A2:A177,A2:A177),0))

This returns the most occurred title, under 2 conditions.

  1. I use Ctrl+Shift+Enter (which seems to be loop through the range?)
  2. There are no empty spaces within the range I specified.

I would need to improve this formula such that it takes E:E, where the type is Cartoon, and when A'x' is not empty. (this formula doesnt seem to work when the range is empty.

This is my first day using excel formula, and I am already coming across this. lol

Further Update

Considering the scenario I given above, I am expecting to use =movieMode(2)

The results should be

----------------------------
-Finding Nemo    - 5 
-Dragon Ball     - 3
----------------------------

I am expecting the 'cartoon' filter to be set into the function by default. I never want action to appear at any point, nor for it to be a variable.

If however, I use

-movieMode(1)

The expected results is

-------------------
-Finding Nemo  - 5
-------------------

Upvotes: 2

Views: 2677

Answers (2)

bonCodigo
bonCodigo

Reputation: 14361

Here is a solution using Scripting object Dictionary and rather not very efficient Range processing at the end. However I utilized Application.ScreenUpdating = False to keep some performance boost and to eliminate eye-flickering screen updates.....This is a Sub where as you may also use it as a function by giving a parameter for Top N. 

Option Explicit

Sub getTopN()
Dim ws As Worksheet
Dim rng As Range
Dim vArr As Variant, d As Object, aL As Object
Dim i As Integer, j As Integer, lastRow As Long
Dim topN As Integer

Set d = CreateObject("Scripting.Dictionary")
Set ws = Sheets(1)
Set rng = ws.Range("A2")
topN = ws.Range("B2").Value '-- for testing it's 2
'-- get last used row dynamically
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'--since data starting with row 2
lastRow = lastRow - 1
vArr = WorksheetFunction.Transpose(rng.Resize(lastRow).Value)

For i = LBound(vArr) To UBound(vArr)
    If Not d.Exists(RTrim(vArr(i))) Then
        j = 1
        d.Add RTrim(vArr(i)), j
    Else
        d.Item(RTrim(vArr(i))) = d.Item(RTrim(vArr(i))) + 1
    End If
Next i

'-- screen updating false
Application.ScreenUpdating = False

'-- output items, keys in to sheet
Set rng = ws.Range("C2")
rng.Resize(UBound(d.keys) + 1) = Application.Transpose(d.keys)
rng.Offset(0, 1).Resize(UBound(d.items) + 1) = Application.Transpose(d.items)

'-- sort this new range , top N
Set rng = rng.Resize(UBound(d.items) + 1, 2)
rng.Sort key1:=Range("D2"), order1:=xlDescending, header:=xlNo
'-- copy topN rows into a temp range
ws.Range("E2").Resize(topN, 2) = rng.Resize(topN, 2).Value
'-- clean up everything other than top N rows
rng.ClearContents
rng.Resize(topN, 2).Value = ws.Range("E2").Resize(topN, 2).Value
ws.Range("C1").Value = "Top N Movies"
ws.Range("E2").Resize(topN, 2).ClearContents
'-- release memory
Set d = Nothing

Application.ScreenUpdating = True
End Sub

Output:

enter image description here

Upvotes: 1

Brendon McKeon
Brendon McKeon

Reputation: 401

Use this VBA function from cpearson.com to return an array with only the distinct values. Once you have that, you can implement the logic below (which is similar to the formula you already have) to generate your results. These are worksheet formulas but you should be able to accomplish the same thing in VBA. The cpearson website is a good resource for VBA, by the way. 

title genre       distinct  cpearsonVBA     count                tieBreak         rank            #_of_results   filter_array        result
----------------------------------------------------------------------------------------------------------------------------------------------------
Finding Nemo      Cartoon   Finding Nemo    =COUNTIFS(A:A,C:C)   =ROW()^-9+D:D    =RANK(E:E,E:E)   2             =IF(F:F<=$G$2,1,0)  =IF(H:H,C:C,"")
Finding Nemo      Cartoon   Inception       =COUNTIFS(A:A,C:C)   =ROW()^-9+D:D    =RANK(E:E,E:E)                 =IF(F:F<=$G$2,1,0)  =IF(H:H,C:C,"")
Finding Nemo      Cartoon   Dragon Ball     =COUNTIFS(A:A,C:C)   =ROW()^-9+D:D    =RANK(E:E,E:E)                 =IF(F:F<=$G$2,1,0)  =IF(H:H,C:C,"")
Finding Nemo      Cartoon              
Finding Nemo      Cartoon              
Inception         Action             
Inception         Action             
Inception         Action             
Dragon Ball       Cartoon              
Dragon Ball       Cartoon              
Dragon Ball       Cartoon

Upvotes: 0

Related Questions