How to find Second Mode across various columns

I wrote a function that can do it.

=ModeN(nth Mode, ranges)

=ModeN(1.F2,I2,L2,O2,R2) - 1st mode
=ModeN(2,F2,I2,L2,O2,R2) - 2nd mode, etc

Public Function ModeN(intNum As Integer, ParamArray Args() As Variant) As Long
'// by michael petox 2015-Aug-28
'// calculates nth mode for noncontiguous cells

Dim i           As Long
Dim x           As Long
Dim tmp         As Double
Dim K           As Variant
Dim modecount   As Long
Dim dict        As Object
Set dict = CreateObject("Scripting.Dictionary")
Stop

For i = 0 To UBound(Args)
    If Not dict.exists(Args(i).Value) Then
        For Each K In Args
            If Args(i) = K Then x = x + 1
        Next
        dict.Add Args(i).Value, x
        x = 0
    End If
Next

modecount = WorksheetFunction.Large(dict.Items, intNum)

For i = 0 To dict.Count - 1
    If dict.Items()(i) = modecount Then
        tmp = dict.Keys()(i)
        Exit For
    End If
Next
ModeN = tmp
Set dict = Nothing
End Function

How to install your new code

1. Copy the Excel VBA code
2. Select the workbook in which you want to store the Excel VBA code
3. Press Alt+F11 to open the Visual Basic Editor
4. Choose Insert > Module
5. Edit > Paste the macro into the module that appeared
6. Close the VBEditor
7. Save your workbook (Excel 2007+ select a macro-enabled file format, like *.xlsm)

To run the Excel VBA code:

1. Press Alt-F8 to open the macro list
2. Select a macro in the list
3. Click the Run button

What exactly are you trying to do? MODE gives the most frequent value in a range. If there isn't a most frequent value in the range, an error will be the result.

I omitted a step which I should probably go back and figure out to make the result more consistent: reordering the array from highest to lowest value.
Then simply pulling the nth index of that array would produce nth most occurring value even for ties.

I have no clue how to reorder a Dictionary by value. =(

Everyone,
Thank you for your contributions!

daffodil11,
I've run your code and I believe I can make it work with the iferror function when a 2nd mode doesn't really exist (e.g., mode1 and mode2 are the same number), otherwise it will return an #VALUE! error in the cell I apply the function into.

I really like this solution so far, and I also like that it defaults to the 1st value found (w.r.t. to left-to-right column order) for a secondary mode!

The only hiccup I've found with this one so far (beyond the aforementioned) is that it has a hard time trying to determine anything beyond the 2nd mode, it seems to error out (#VALUE!), and I can't seem to use a simple iferror approach to tell it to pick one of the other remaining values.


jason.b75,
Not sure if I applied your formula correctly, but I appear to be getting inconsistent results, sometimes the 1st mode, other times the 2nd.
Can you please elaborate on implementation, and also how to modify this for modes 3, 4, etc?
Also, could you explain what's going on with the A1:A5 or A1:A6 range references?


newdoverman,
I need the 2nd and possibly 3rd, 4th, etc., modes as backups for when the Mode1 value isn't feasible.
Basically, given a list of 5 non-contiguous values, the value that appears the most should be the closest match to fit my need.
If however, that closest match doesn't work, then I need to reference the 2nd closest match as the alternative solution for consideration. Failing that, 3rd, 4th, and up to 5th mode values will need to be evaluated in those orders.

My sample workbook only consisted of 13 or so rows, but I will need to do this for over 12,000 rows in the final workbook.

I haven't tested the formula with large volumes of data, only your sample and a couple of extra rows to test some data patterns that were cause for concern, so not sure about processor intensiveness, but that was one of my reasons for referring to the formula as impractical.

The other would be ease of use, how many people would be able to follow the formula and change it if you needed to add another column?

edit:- 3rd concern removed post research.

That formula is impressive. I tried a few variations incorporating FREQUENCY to get around the noncontiguous limitations of COUNTIF and MATCH.

After like an hour I caved and started working on my first ever UDF. And then things got complicated. And terrible.

It took a billion years, but I found some code to sort the dictionary by Item value. Then I converted the code to Late Binding and descending order.

In the event of a tie, it shows the lowest order key first. Given the following range A1:A10: {3,5,3,5,3,5,7,4,7,4}

=ModeN(1,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) = 3
=ModeN(2,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) = 5
=ModeN(3,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) = 4
=ModeN(4,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) = 7
=ModeN(5,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) = #VALUE!

Public Function ModeN(intNum As Integer, ParamArray Args() As Variant) As Long
'// by michael petox 2015-Aug-28
'// calculates nth mode for noncontiguous cells

Dim i           As Long
Dim x           As Long
Dim tmp         As Double
Dim K           As Variant
Dim modecount   As Long
Dim Dict        As Object
Set Dict = CreateObject("Scripting.Dictionary")


For i = 0 To UBound(Args)
    If Not Dict.exists(Args(i).Value) Then
        For Each K In Args
            If Args(i) = K Then x = x + 1
        Next
        Dict.Add Args(i).Value, x
        x = 0
    End If
Next

Call SortDictionaryByItem(Dict)

ModeN = Dict.Keys()(intNum - 1)
Set Dict = Nothing
End Function

Sub SortDictionaryByItem(Dict As Object)
    
    Dim Arr() As Variant
    Dim Temp1 As Variant
    Dim Temp2 As Variant
    Dim Txt As String
    Dim i As Long
    Dim j As Long
        
    'Allocate storage space for the dynamic array
    ReDim Arr(0 To Dict.Count - 1, 0 To 1)
    
    'Fill the array with the keys and items from the Dictionary
    For i = 0 To Dict.Count - 1
        Arr(i, 0) = Dict.Keys()(i)
        Arr(i, 1) = Dict.Items()(i)
    Next i
    
    'Sort the array using the bubble sort method
    For i = LBound(Arr, 1) To UBound(Arr, 1) - 1
        For j = i + 1 To UBound(Arr, 1)
            If Arr(i, 1) < Arr(j, 1) Then
                Temp1 = Arr(j, 0)
                Temp2 = Arr(j, 1)
                Arr(j, 0) = Arr(i, 0)
                Arr(j, 1) = Arr(i, 1)
                Arr(i, 0) = Temp1
                Arr(i, 1) = Temp2
            End If
        Next j
    Next i
    
    Dict.RemoveAll
    
    'Add the sorted keys and items from the array back to the Dictionary
    For i = LBound(Arr, 1) To UBound(Arr, 1)
        Dict.Add Key:=Arr(i, 0), Item:=Arr(i, 1)
    Next i
    
End Sub

That was hard stuff.