Hi Ray,
Ideally, the solution would be scalable (allow users to select larger
or smaller range) and also allow for choosing the Most frequent, 2nd
most frequent, 3rd most frequent, etc values. So, something like:
=UDFname(range,3) would return the 3rd most frequently occurring text
string in the specified range.
A bit convoluted, but it seems to work:
Option Explicit
Public Function CountTextLarge(RangeWithWords As Range, Optional lIndex As Long
= 1)
Dim vWords() As Variant
Dim vAllWords() As Variant
Dim oRng As Range
Dim sTest As String
Dim lCt As Long
Dim lAllCt As Long
Dim lWordCounts() As Long
Dim lCurIndex As Long
ReDim vWords(1 To 1)
ReDim vAllWords(1 To 1)
Dim lCurCt As Long
On Error Resume Next
For Each oRng In RangeWithWords.Cells
lAllCt = lAllCt + 1
ReDim Preserve vAllWords(1 To lAllCt)
vAllWords(lAllCt) = oRng.Value2
If Not IsIn(vWords, oRng.Value2) Then
lCt = lCt + 1
ReDim Preserve vWords(1 To lCt)
vWords(lCt) = oRng.Value2
End If
Next
ReDim lWordCounts(1 To UBound(vWords))
For lCt = 1 To UBound(vWords)
For lAllCt = 1 To UBound(vAllWords)
If vAllWords(lAllCt) = vWords(lCt) Then
lWordCounts(lCt) = lWordCounts(lCt) + 1
End If
Next
Next
CountTextLarge = Application.Large(lWordCounts, lIndex)
For lCt = 1 To UBound(lWordCounts)
If CountTextLarge = lWordCounts(lCt) Then
CountTextLarge = vWords(lCt)
Exit Function
End If
Next
End Function
Function IsIn(vCol As Variant, vVal As Variant) As Boolean
Dim lCt As Long
On Error Resume Next
For lCt = LBound(vCol) To UBound(vCol)
If vCol(lCt) = vVal Then
IsIn = True
Exit Function
End If
Next
End Function
Call like this:
=CountTextLarge(A2:A100,2)
Regards,
Jan Karel Pieterse
Excel MVP
http://www.jkp-ads.com
Member of:
Professional Office Developer Association
www.proofficedev.com