This post will guide you how to find the most common value in a column of data in Excel. How do I find the most frequently occurring text from a list with array formula in Excel. How to extract the most frequent value from a list of data with VBA Macro in Excel.
Find Most Common Value with Formula
Assuming that you have a list of data in range B1:B9, in which contain product names. And you need to find the most common text value from the range of cells B1:B9. How to do it. You can use an Excel array formula based on the INDEX function, the MODE function and the MATCH function to extract the most common value from a given range of cells. Like this:
=INDEX($B$1:$B$9,MODE(MATCH($B$1:$B$9,$B$1:$B$9,0)))
Type this formula into a blank cell and press Shift + Ctrl + Enter keys on your keyboard to apply this array formula.
You would notice that the most common value is extracted.
Find Most Common Value with VBA
You can also use an Excel VBA Macro to achieve the same result of extracting the most common value from a selected range of cells. Here are the steps:
#1 open your excel workbook and then click on “Visual Basic” command under DEVELOPER Tab, or just press “ALT+F11” shortcut.
#2 then the “Visual Basic Editor” window will appear.
#3 click “Insert” ->”Module” to create a new module.
#4 paste the below VBA code (get code from here) into the code window. Then clicking “Save” button.
Sub HighestFrequency() Dim Arr() As Variant, ArrItem As Variant, CurNum As Long, Rng As Range Dim TopNum As Long, TopItemsNum() As Variant, TopItemsAlpha() As Variant Dim SumNum As Variant, ArrTop As Variant, ArrTop2 As Variant, strConcat As String Dim Tmp, BlnNum As Boolean, BlnAlpha As Boolean Set Rng = Range("B1:B9") Arr = UNIQUEVALUES(Rng) For Each ArrItem In Arr CurNum = WorksheetFunction.CountIf(Rng, "=" & ArrItem) If CurNum > TopNum Then Erase TopItemsNum Erase TopItemsAlpha TopNum = CurNum If IsNumeric(ArrItem) Then ReDim TopItemsNum(0) TopItemsNum(0) = ArrItem Else ReDim TopItemsAlpha(0) TopItemsAlpha(0) = ArrItem End If ElseIf CurNum = TopNum Then If IsNumeric(ArrItem) Then On Error Resume Next ReDim Preserve TopItemsNum(UBound(TopItemsNum) + 1) If Err.Number <> 0 Then ReDim TopItemsNum(0) Err.Clear On Error GoTo 0 TopItemsNum(UBound(TopItemsNum)) = ArrItem Else On Error Resume Next ReDim Preserve TopItemsAlpha(UBound(TopItemsAlpha) + 1) If Err.Number <> 0 Then ReDim TopItemsAlpha(0) Err.Clear On Error GoTo 0 TopItemsAlpha(UBound(TopItemsAlpha)) = ArrItem End If End If Next ArrItem On Error Resume Next Tmp = TopItemsNum(0) If Err.Number <> 0 Or Tmp = "" Then GoTo Skip On Error GoTo 0 For Each ArrTop In TopItemsNum BlnNum = True SumNum = ArrTop + SumNum Next ArrTop Skip: On Error Resume Next Tmp = TopItemsAlpha(0) If Err.Number <> 0 Or Tmp = "" Then GoTo Skip2 On Error GoTo 0 For Each ArrTop2 In TopItemsAlpha If Err.Number <> 0 Then Exit For BlnAlpha = True strConcat = ArrTop2 & strConcat Next ArrTop2 On Error GoTo 0 Skip2: If BlnNum = True And BlnAlpha = True Then MsgBox "The most frequent value appears " & TopNum & " times." & vbLf & vbLf & _ "Numeric values average to... " & SumNum & vbLf & vbLf & _ "Alpha values concatenate to... " & strConcat ElseIf BlnNum = True Then MsgBox "The most frequent value appears " & TopNum & " times." & vbLf & vbLf & _ "Numeric values average to... " & SumNum Else MsgBox "The most frequent value appears " & TopNum & " times." & vbLf & vbLf & _ "Alpha values concatenate to... " & strConcat End If End Sub Function UNIQUEVALUES(ParamArray Target() As Variant) As Variant Dim UniqueCollection As New Collection, TmpArr() As Variant Dim Rng As Range, vItem As Variant, Cell As Range Application.Volatile 'Merge the target ranges into one range For Each vItem In Target If Rng Is Nothing Then Set Rng = vItem Else Set Rng = Application.Union(Rng, vItem) End If Next vItem 'loop through range and create 1D array For Each Cell In Rng On Error Resume Next UniqueCollection.Add Cell.Value, CStr(Cell.Value) If Err.Number = 0 Then 'if already in collection an error will occur ReDim Preserve TmpArr(UBound(TmpArr) + 1) If Err.Number <> 0 Then ReDim TmpArr(0) On Error GoTo 0 TmpArr(UBound(TmpArr)) = Cell.Value End If Err.Clear Next Cell 'Return result. If a single column transpose array. UNIQUEVALUES = TmpArr End Function
#5 back to the current worksheet, then run the above excel macro. Click Run button.
#6 Let’ see the result:
Related Functions
- Excel INDEX function
The Excel INDEX function returns a value from a table based on the index (row number and column number)The INDEX function is a build-in function in Microsoft Excel and it is categorized as a Lookup and Reference Function.The syntax of the INDEX function is as below:= INDEX (array, row_num,[column_num])… - Excel MATCH function
The Excel MATCH function search a value in an array and returns the position of that item.The MATCH function is a build-in function in Microsoft Excel and it is categorized as a Lookup and Reference Function.The syntax of the MATCH function is as below:= MATCH (lookup_value, lookup_array, [match_type])….